From d67b475ee3b9a4c52892a2a35533628ad8662f02 Mon Sep 17 00:00:00 2001 From: Ed Liu Date: Mon, 6 Jun 2022 15:33:06 -0600 Subject: [PATCH 001/124] Initial commit of the adaptive close_state_caching --- .../modules/assimilation/assim_tools_mod.f90 | 28 +++++++++++++++++-- models/mpas_atm/work/input.nml | 21 ++++++++++++-- 2 files changed, 45 insertions(+), 4 deletions(-) diff --git a/assimilation_code/modules/assimilation/assim_tools_mod.f90 b/assimilation_code/modules/assimilation/assim_tools_mod.f90 index 36c3fe012f..ed98108105 100644 --- a/assimilation_code/modules/assimilation/assim_tools_mod.f90 +++ b/assimilation_code/modules/assimilation/assim_tools_mod.f90 @@ -373,6 +373,7 @@ subroutine filter_assim(ens_handle, obs_ens_handle, obs_seq, keys, & logical :: local_varying_ss_inflate logical :: local_ss_inflate logical :: local_obs_inflate +logical :: close_obs_caching_init ! allocate rather than dump all this on the stack allocate(close_obs_dist( obs_ens_handle%my_num_vars), & @@ -397,6 +398,9 @@ subroutine filter_assim(ens_handle, obs_ens_handle, obs_seq, keys, & ! Initialize assim_tools_module if needed if (.not. module_initialized) call assim_tools_init() +!EL Record down the initial value of close_obs_caching after initialization +close_obs_caching_init = close_obs_caching + !HK make window for mpi one-sided communication ! used for vertical conversion in get_close_obs ! Need to give create_mean_window the mean copy @@ -698,7 +702,7 @@ subroutine filter_assim(ens_handle, obs_ens_handle, obs_seq, keys, & call get_close_state_cached(gc_state, base_obs_loc, base_obs_type, & my_state_loc, my_state_kind, my_state_indx, num_close_states, close_state_ind, close_state_dist, & ens_handle, last_base_states_loc, last_num_close_states, last_close_state_ind, & - last_close_state_dist, num_close_states_cached, num_close_states_calls_made) + last_close_state_dist, num_close_states_cached, num_close_states_calls_made, my_num_state) !call test_close_obs_dist(close_state_dist, num_close_states, i) ! Loop through to update each of my state variables that is potentially close @@ -785,7 +789,16 @@ subroutine filter_assim(ens_handle, obs_ens_handle, obs_seq, keys, & ! diagnostics for stats on saving calls by remembering obs at the same location. ! change .true. to .false. in the line below to remove the output completely. + +! EL: +if (close_obs_caching_init) then + if (num_close_obs_cached == 0 .or. num_close_states_cached == 0) then + print *, "No observations or states was cached. Setting close_obs_caching = .false. may significantly improve the runtime" + endif +endif + if (close_obs_caching) then + if (num_close_obs_cached > 0 .and. do_output()) then print *, "Total number of calls made to get_close_obs for obs/states: ", & num_close_obs_calls_made + num_close_states_calls_made @@ -2623,7 +2636,7 @@ end subroutine get_close_obs_cached subroutine get_close_state_cached(gc_state, base_obs_loc, base_obs_type, & my_state_loc, my_state_kind, my_state_indx, num_close_states, close_state_ind, close_state_dist, & ens_handle, last_base_states_loc, last_num_close_states, last_close_state_ind, & - last_close_state_dist, num_close_states_cached, num_close_states_calls_made) + last_close_state_dist, num_close_states_cached, num_close_states_calls_made, my_num_state) type(get_close_type), intent(in) :: gc_state type(location_type), intent(inout) :: base_obs_loc, my_state_loc(:) @@ -2637,6 +2650,7 @@ subroutine get_close_state_cached(gc_state, base_obs_loc, base_obs_type, & integer, intent(inout) :: last_close_state_ind(:) real(r8), intent(inout) :: last_close_state_dist(:) integer, intent(inout) :: num_close_states_cached, num_close_states_calls_made +integer :: my_num_state ! Number of either states or observations ! This logic could be arranged to make code less redundant if (.not. close_obs_caching) then @@ -2660,8 +2674,18 @@ subroutine get_close_state_cached(gc_state, base_obs_loc, base_obs_type, & last_close_state_dist(:) = close_state_dist(:) num_close_states_calls_made = num_close_states_calls_made +1 endif +! EL Check if too few states are cached. If so, turn off close_obs_caching for the user. + if ( num_close_states_calls_made > my_num_state / 10.0_r8 ) then + if ( num_close_states_cached / num_close_states_calls_made <= 0.05_r8 ) then + print *, "Too few states are cached, turning off close_obs_caching" + close_obs_caching = .false. + endif + endif endif +! Test to set the close_obs_caching to false after the first run. +close_obs_caching = .false. + end subroutine get_close_state_cached !-------------------------------------------------------------------- diff --git a/models/mpas_atm/work/input.nml b/models/mpas_atm/work/input.nml index c4f4d0c20a..c1f7403fac 100644 --- a/models/mpas_atm/work/input.nml +++ b/models/mpas_atm/work/input.nml @@ -237,6 +237,22 @@ write_nml = 'file' / +# &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_qty_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90' +# output_obs_qty_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90' +# obs_type_files = '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90', +# '../../../observations/forward_operators/obs_def_altimeter_mod.f90', +# '../../../observations/forward_operators/obs_def_gts_mod.f90', +# '../../../observations/forward_operators/obs_def_metar_mod.f90', +# '../../../observations/forward_operators/obs_def_gps_mod.f90', +# '../../../observations/forward_operators/obs_def_vortex_mod.f90', +# '../../../observations/forward_operators/obs_def_rel_humidity_mod.f90', +# '../../../observations/forward_operators/obs_def_dew_point_mod.f90' +# quantity_files = '../../../assimilation_code/modules/observations/atmosphere_quantities_mod.f90' +# / &preprocess_nml overwrite_output = .true. input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90' @@ -251,9 +267,10 @@ '../../../observations/forward_operators/obs_def_vortex_mod.f90', '../../../observations/forward_operators/obs_def_rel_humidity_mod.f90', '../../../observations/forward_operators/obs_def_dew_point_mod.f90' - quantity_files = '../../../assimilation_code/modules/observations/atmosphere_quantities_mod.f90' + '../../../observations/forward_operators/obs_def_rttov_mod.f90' + quantity_files = '../../../assimilation_code/modules/observations/default_quantities_mod.f90' / - + &obs_sequence_tool_nml num_input_files = 1 filename_seq = 'obs_seq.final' From 874cf225b5999dc51f6d757c622d6794d110a3ca Mon Sep 17 00:00:00 2001 From: Ed Liu Date: Mon, 6 Jun 2022 15:35:32 -0600 Subject: [PATCH 002/124] Comment out the close_state_cach = .false. in get_close_state_cached --- assimilation_code/modules/assimilation/assim_tools_mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/assimilation_code/modules/assimilation/assim_tools_mod.f90 b/assimilation_code/modules/assimilation/assim_tools_mod.f90 index ed98108105..abd943d70e 100644 --- a/assimilation_code/modules/assimilation/assim_tools_mod.f90 +++ b/assimilation_code/modules/assimilation/assim_tools_mod.f90 @@ -2684,7 +2684,7 @@ subroutine get_close_state_cached(gc_state, base_obs_loc, base_obs_type, & endif ! Test to set the close_obs_caching to false after the first run. -close_obs_caching = .false. +! close_obs_caching = .false. end subroutine get_close_state_cached From 04282837d634919c3fdbbc7833fb52ac26ee4c5e Mon Sep 17 00:00:00 2001 From: Ed Liu Date: Fri, 10 Jun 2022 13:11:32 -0600 Subject: [PATCH 003/124] Add do_output for the print statements --- assimilation_code/modules/assimilation/assim_tools_mod.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/assimilation_code/modules/assimilation/assim_tools_mod.f90 b/assimilation_code/modules/assimilation/assim_tools_mod.f90 index abd943d70e..745f3dd90e 100644 --- a/assimilation_code/modules/assimilation/assim_tools_mod.f90 +++ b/assimilation_code/modules/assimilation/assim_tools_mod.f90 @@ -792,7 +792,7 @@ subroutine filter_assim(ens_handle, obs_ens_handle, obs_seq, keys, & ! EL: if (close_obs_caching_init) then - if (num_close_obs_cached == 0 .or. num_close_states_cached == 0) then + if ( ( num_close_obs_cached == 0 .or. num_close_states_cached == 0 ) .and. (do_output()) ) then print *, "No observations or states was cached. Setting close_obs_caching = .false. may significantly improve the runtime" endif endif @@ -2677,7 +2677,9 @@ subroutine get_close_state_cached(gc_state, base_obs_loc, base_obs_type, & ! EL Check if too few states are cached. If so, turn off close_obs_caching for the user. if ( num_close_states_calls_made > my_num_state / 10.0_r8 ) then if ( num_close_states_cached / num_close_states_calls_made <= 0.05_r8 ) then - print *, "Too few states are cached, turning off close_obs_caching" + if (do_output()) then + print *, "Too few states are cached, turning off close_obs_caching" + endif close_obs_caching = .false. endif endif From 774b9cc6b887dfcee989a33920bfd13616ea0499 Mon Sep 17 00:00:00 2001 From: Ed Liu Date: Fri, 8 Jul 2022 15:40:27 -0600 Subject: [PATCH 004/124] New I/O scheme with offline processing of large input state --- .../model_mod_check/model_mod_check.f90 | 7 +- models/MITgcm_ocean/model_mod.f90 | 142 +++- models/MITgcm_ocean/model_mod.nml | 1 + models/MITgcm_ocean/work/dart_nc_reduce.f90 | 661 ++++++++++++++++++ models/MITgcm_ocean/work/input.nml | 2 +- 5 files changed, 788 insertions(+), 25 deletions(-) create mode 100644 models/MITgcm_ocean/work/dart_nc_reduce.f90 diff --git a/assimilation_code/programs/model_mod_check/model_mod_check.f90 b/assimilation_code/programs/model_mod_check/model_mod_check.f90 index ee4eea51a0..c35ff0a07e 100644 --- a/assimilation_code/programs/model_mod_check/model_mod_check.f90 +++ b/assimilation_code/programs/model_mod_check/model_mod_check.f90 @@ -556,9 +556,12 @@ subroutine check_all_meta_data() kind_string=qty_string) ! CLM has (potentially many) columns and needs i7 ish precision - write(string1,'(i11,1x,''i,j,k'',3(1x,i7),'' domain '',i2)') & +! write(string1,'(i11,1x,''i,j,k'',3(1x,i7),'' domain '',i2)') & +! iloc, ix, iy, iz, dom_id + ! EL: integer to short for the new I/O method + ! Change to long int to avoid problems + write(string1,'(i21,1x,''i,j,k'',3(1x,i21),'' domain '',i2)') & iloc, ix, iy, iz, dom_id - call get_state_meta_data(iloc, loc, var_type) metadata_qty_string = trim(get_name_for_quantity(var_type)) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index 4f35443e5c..92eb616789 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -20,7 +20,7 @@ module model_mod get_close_state, get_close_obs, set_location, & VERTISHEIGHT, get_location, is_vertical, & convert_vertical_obs, convert_vertical_state - +! EL use only nc_check was here, deleted for now for testing use utilities_mod, only : error_handler, E_ERR, E_WARN, E_MSG, & logfileunit, get_unit, nc_check, do_output, to_upper, & find_namelist_in_file, check_namelist_read, & @@ -55,6 +55,9 @@ module model_mod get_dart_vector_index, get_num_variables, & get_domain_size, & get_io_clamping_minval + +use netcdf_utilities_mod, only : nc_open_file_readonly, nc_get_variable, & + nc_get_variable_size use netcdf @@ -258,6 +261,9 @@ module model_mod ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) +real(r4), allocatable :: XC_sq(:), YC_sq(:), XG_sq(:), YG_sq(:), ZC_sq(:) +integer :: xcsqsize, ycsqsize, zcsqsize +integer :: shape_file_id real(r8) :: ocean_dynamics_timestep = 900.0_r4 integer :: timestepcount = 0 @@ -287,7 +293,7 @@ module model_mod assimilation_period_seconds, & model_perturbation_amplitude, & model_shape_file, & - mitgcm_variables + mitgcm_variables logical :: go_to_dart = .false. logical :: do_bgc = .false. @@ -523,10 +529,34 @@ subroutine static_init_model() if (do_output()) write( * , *) ' Nx, Ny, Nz = ', Nx, Ny, Nz call parse_variable_input(mitgcm_variables, model_shape_file, nvars, & - var_names, quantity_list, clamp_vals, update_list) + var_names, quantity_list, clamp_vals, update_list) domain_id = add_domain(model_shape_file, nvars, & var_names, quantity_list, clamp_vals, update_list ) +! Open the file +shape_file_id = nc_open_file_readonly(model_shape_file) +! Get the size +call nc_get_variable_size(shape_file_id, 'XC_3D', xcsqsize) +call nc_get_variable_size(shape_file_id, 'YC_3D', ycsqsize) +call nc_get_variable_size(shape_file_id, 'ZC_3D', zcsqsize) + +! Allocate the variable and get the values +allocate(xc_sq(xcsqsize)) +allocate(yc_sq(ycsqsize)) +allocate(zc_sq(zcsqsize)) +allocate(xg_sq(xcsqsize)) +allocate(yg_sq(ycsqsize)) + +call nc_get_variable(shape_file_id, 'XC_3D', XC_sq) +call nc_get_variable(shape_file_id, 'YC_3D', YC_sq) +call nc_get_variable(shape_file_id, 'ZC_3D', ZC_sq) + +! EL: tentative solution of XG values +do i=1, xcsqsize + XG_sq(i) = XC_sq(i) - 0.5*delX(1) + YG_sq(i) = YC_sq(i) - 0.5*delY(1) +enddo + model_size = get_domain_size(domain_id) @@ -534,7 +564,6 @@ subroutine static_init_model() end subroutine static_init_model - function get_model_size() !------------------------------------------------------------------ ! @@ -954,6 +983,67 @@ function lon_dist(lon1, lon2) end function lon_dist +function get_dart_vector_index_new(iloc, jloc, kloc, dom_id, var_id) + +integer, intent(in) :: iloc, jloc, kloc +integer, intent(in) :: dom_id, var_id +integer(i8) :: get_dart_vector_index_new +real(r4) :: x_var, y_var, z_var ! The target lat, lon, level values +integer :: i ! loop counter +logical :: x_close, y_close, z_close +integer :: ct + +! integer :: ndims +integer(i8) :: offset +! integer :: dsize(NF90_MAX_VAR_DIMS) + +! Step 1 +offset = get_index_start(dom_id, var_id) + +! Step 2 +x_var = XC(iloc) +y_var = YC(jloc) +z_var = ZC(kloc) + +! Set the default value to be -1 +get_dart_vector_index_new = -1 +! Step 3, 4 +do i=1, xcsqsize + x_close = .FALSE. + y_close = .FALSE. + z_close = .FALSE. + ! If we find the value + if ( XC_sq(i) .eq. x_var ) then + x_close = .TRUE. + endif + if ( YC_sq(i) .eq. y_var ) then + y_close = .TRUE. + endif + + if ( ZC_sq(i) .eq. z_var ) then + z_close = .TRUE. + endif + + if (x_close .and. y_close .and. z_close )then + get_dart_vector_index_new = offset + i - 1 + exit + endif +enddo + +end function get_dart_vector_index_new + +!> The iloc, jloc, and kloc here are the grid indices +!> For example, it might be (1000,1000,50) +!> For the original case, the approach was to find the offset (i.e. where the specific +!> variable starts in the state vector, then add number of values in dimensions to the offset +!> to get the values. + +!> NEW APPROACH: +!> 1. still need to find offset +!> 2. Need to find XC(iloc), YC(jloc), ZC(kloc) +!> 3. Start searching for the values above in XC_sq, YC_sq, ZC_sq (long arrays) +!> 4. return the value and add offset, that should be it. + function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, masked) !======================================================================= ! @@ -963,7 +1053,7 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas integer, intent(in) :: var_id ! state variable type(ensemble_type), intent(in) :: state_handle integer, intent(in) :: ens_size -logical, intent(out) :: masked +logical, intent(out) :: masked real(r8) :: get_val(ens_size) integer(i8) :: state_index @@ -971,8 +1061,13 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas if ( .not. module_initialized ) call static_init_model -state_index = get_dart_vector_index(lon_index, lat_index, level, domain_id, var_id) -get_val = get_state(state_index,state_handle) +state_index = get_dart_vector_index_new(lon_index, lat_index, level, domain_id, var_id) + +if (state_index .ne. -1) then + get_val = get_state(state_index,state_handle) +else + masked = .true. +endif ! Masked returns false if the value is masked ! A grid variable is assumed to be masked if its value is FVAL. @@ -984,11 +1079,12 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas ! trans_mitdart already looks for 0.0 and makes them FVAL ! So, in the condition below we don't need to check for zeros ! The only mask is FVAL -masked = .false. -do i=1,ens_size -! if(get_val(i) == FVAL .or. get_val(i) == 0.0_r8 ) masked = .true. - if(get_val(i) == FVAL) masked = .true. -enddo + +! No need to search for fill values now. Default get_state_vector_index_new is -1 +! do i=1,ens_size +! ! if(get_val(i) == FVAL .or. get_val(i) == 0.0_r8 ) masked = .true. +! if(get_val(i) == FVAL) masked = .true. +! enddo end function get_val @@ -1072,25 +1168,27 @@ subroutine get_state_meta_data(index_in, location, qty) type(location_type), intent(out) :: location integer, intent(out), optional :: qty -real(r8) :: lat, lon, depth +real(r4) :: lat, lon, depth integer :: iloc, jloc, kloc if ( .not. module_initialized ) call static_init_model call get_model_variable_indices(index_in, iloc, jloc, kloc, kind_index = qty) -lon = XC(iloc) -lat = YC(jloc) -depth = ZC(kloc) +! The new array is 1-D + +lon = XC_sq(iloc) +lat = YC_sq(iloc) +depth = ZC_sq(iloc) ! Acounting for surface variables and those on staggered grids ! MEG: check chl's depth here if (qty == QTY_SEA_SURFACE_HEIGHT .or. & qty == QTY_SURFACE_CHLOROPHYLL) depth = 0.0_r8 -if (qty == QTY_U_CURRENT_COMPONENT) lon = XG(iloc) -if (qty == QTY_V_CURRENT_COMPONENT) lat = YG(jloc) +if (qty == QTY_U_CURRENT_COMPONENT) lon = XG_sq(iloc) +if (qty == QTY_V_CURRENT_COMPONENT) lat = YG_sq(iloc) -location = set_location(lon, lat, depth, VERTISHEIGHT) +location = set_location(real(lon, r8), real(lat, r8), real(depth, r8), VERTISHEIGHT) end subroutine get_state_meta_data @@ -1323,7 +1421,7 @@ subroutine pert_model_copies(state_ens_handle, ens_size, pert_amp, interf_provid clamp_min_val = get_io_clamping_minval(domain_id, ivar) - INDICES : do i = start_ind, end_ind + INDICES : do i = 1, state_ens_handle%my_num_vars MEMBERS : do copy = 1, ens_size ! Only perturb the actual ocean cells; @@ -1361,12 +1459,12 @@ function read_model_time(filename) read_model_time = model_time -!if (do_output() .and. debug > 0 .and. present(last_time)) then +if (do_output()) then call print_time(read_model_time, str='MITgcm_ocean time is ',iunit=logfileunit) call print_time(read_model_time, str='MITgcm_ocean time is ') call print_date(read_model_time, str='MITgcm_ocean date is ',iunit=logfileunit) call print_date(read_model_time, str='MITgcm_ocean date is ') -!endif +endif end function read_model_time diff --git a/models/MITgcm_ocean/model_mod.nml b/models/MITgcm_ocean/model_mod.nml index ef64b88caa..03b81505ae 100644 --- a/models/MITgcm_ocean/model_mod.nml +++ b/models/MITgcm_ocean/model_mod.nml @@ -2,5 +2,6 @@ assimilation_period_days = 7 assimilation_period_seconds = 0 model_perturbation_amplitude = 0.2 + model_shape_file = 'mem01_reduced.nc' / diff --git a/models/MITgcm_ocean/work/dart_nc_reduce.f90 b/models/MITgcm_ocean/work/dart_nc_reduce.f90 new file mode 100644 index 0000000000..a2aa9b119d --- /dev/null +++ b/models/MITgcm_ocean/work/dart_nc_reduce.f90 @@ -0,0 +1,661 @@ +module netcdf_test + +use netcdf +contains + +function nc_open_file_readonly(filename, context) + +character(len=*), intent(in) :: filename +character(len=*), intent(in), optional :: context +integer :: nc_open_file_readonly + +character(len=*), parameter :: routine = 'nc_open_file_readonly' +integer :: ret, ncid + +ret = nf90_open(filename, NF90_NOWRITE, ncid) +nc_open_file_readonly = ncid + +end function nc_open_file_readonly + + +subroutine nc_define_var_int_Nd(ncid, varname, dimnames, context, filename) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +character(len=*), intent(in) :: dimnames(:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename + +character(len=*), parameter :: routine = 'nc_define_var_int_Nd' +integer :: i, ret, ndims, varid, dimids(NF90_MAX_VAR_DIMS) + +ndims = size(dimnames) + +do i=1, ndims + ret = nf90_inq_dimid(ncid, dimnames(i), dimids(i)) +enddo + +ret = nf90_def_var(ncid, varname, nf90_int, dimids(1:ndims), varid=varid) + +end subroutine nc_define_var_int_Nd + + +function nc_create_file(filename, context) + +character(len=*), intent(in) :: filename +character(len=*), intent(in), optional :: context +integer :: nc_create_file + +character(len=*), parameter :: routine = 'nc_create_file' +integer :: ret, ncid, oldmode + +ret = nf90_create(filename, NF90_CLOBBER, ncid) +nc_create_file = ncid + +! faster if we don't fill the vars first with 'fill' value. +! this works if we are planning to write all vars. (which we are.) + +ret = nf90_set_fill(ncid, NF90_NOFILL, oldmode) + +end function nc_create_file + + +subroutine nc_get_variable_size_Nd(ncid, varname, varsize, context, filename) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +integer, intent(out) :: varsize(:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename + +character(len=*), parameter :: routine = 'nc_get_variable_size_Nd' +integer :: ret, i, ndims, varid, dimids(NF90_MAX_VAR_DIMS) + + +ret = nf90_inq_varid(ncid, varname, varid) + +ret = nf90_inquire_variable(ncid, varid, dimids=dimids, ndims=ndims) + +! if (ndims > size(varsize)) & +! call nc_check(NF90_EDIMSIZE, routine, 'variable '//trim(varname)//' return varsize array too small', & +! context, filename, ncid) +! +! ! in case the var is larger than ndims, set unused dims to -1 +! varsize(:) = -1 +do i=1, ndims + ret = nf90_inquire_dimension(ncid, dimids(i), len=varsize(i)) +enddo + +end subroutine nc_get_variable_size_Nd + + +subroutine nc_get_double_4d(ncid, varname, varvals, context, filename, & + nc_start, nc_count, nc_stride, nc_map) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +real(8), intent(out) :: varvals(:,:,:,:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename +integer, intent(in), optional :: nc_start(:) +integer, intent(in), optional :: nc_count(:) +integer, intent(in), optional :: nc_stride(:) +integer, intent(in), optional :: nc_map(:) + +character(len=*), parameter :: routine = 'nc_get_double_4d' +integer :: ret, varid + +ret = nf90_inq_varid(ncid, varname, varid) +ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) + +end subroutine nc_get_double_4d + + +subroutine nc_get_real_1d(ncid, varname, varvals, context, filename, & + nc_start, nc_count, nc_stride, nc_map) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +real(4), intent(out) :: varvals(:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename +integer, intent(in), optional :: nc_start(:) +integer, intent(in), optional :: nc_count(:) +integer, intent(in), optional :: nc_stride(:) +integer, intent(in), optional :: nc_map(:) + +character(len=*), parameter :: routine = 'nc_get_real_1d' +integer :: ret, varid + +ret = nf90_inq_varid(ncid, varname, varid) +ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) + +end subroutine nc_get_real_1d + + +subroutine nc_get_variable_size_1d(ncid, varname, varsize, context, filename) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +integer, intent(out) :: varsize +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename + +character(len=*), parameter :: routine = 'nc_get_variable_size_1d' +integer :: ret, ndims, varid, dimids(NF90_MAX_VAR_DIMS) + +ret = nf90_inq_varid(ncid, varname, varid) +ret = nf90_inquire_variable(ncid, varid, dimids=dimids, ndims=ndims) +ret = nf90_inquire_dimension(ncid, dimids(1), len=varsize) + +end subroutine nc_get_variable_size_1d + + +subroutine nc_put_real_1d(ncid, varname, varvals, context, filename, & + nc_start, nc_count, nc_stride, nc_map) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +real(4), intent(in) :: varvals(:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename +integer, intent(in), optional :: nc_start(:) +integer, intent(in), optional :: nc_count(:) +integer, intent(in), optional :: nc_stride(:) +integer, intent(in), optional :: nc_map(:) + +character(len=*), parameter :: routine = 'nc_put_real_1d' +integer :: ret, varid + +ret = nf90_inq_varid(ncid, varname, varid) +ret = nf90_put_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) + +end subroutine nc_put_real_1d + + +subroutine nc_define_dimension(ncid, dimname, dimlen, context, filename) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: dimname +integer, intent(in) :: dimlen +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename + +character(len=*), parameter :: routine = 'nc_define_dimension' +integer :: ret, dimid + +ret = nf90_def_dim(ncid, dimname, dimlen, dimid) + +end subroutine nc_define_dimension + +!-------------------------------------------------------------------- + +subroutine nc_define_unlimited_dimension(ncid, dimname, context, filename) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: dimname +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename + +character(len=*), parameter :: routine = 'nc_define_unlimited_dimension' +integer :: ret, dimid + +ret = nf90_def_dim(ncid, dimname, NF90_UNLIMITED, dimid) + +end subroutine nc_define_unlimited_dimension + + +function nc_open_file_readwrite(filename, context) + +character(len=*), intent(in) :: filename +character(len=*), intent(in), optional :: context +integer :: nc_open_file_readwrite + +character(len=*), parameter :: routine = 'nc_open_file_readwrite' +integer :: ret, ncid, oldmode + +ret = nf90_open(filename, NF90_WRITE, ncid) +nc_open_file_readwrite = ncid + +! faster if we don't fill the vars first with 'fill' value. +! this works if we are planning to write all vars. (which we are.) + +ret = nf90_set_fill(ncid, NF90_NOFILL, oldmode) + +end function nc_open_file_readwrite + + +subroutine nc_close_file(ncid, context, filename) + +integer, intent(in) :: ncid +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename + +character(len=*), parameter :: routine = 'nc_close_file' +integer :: ret + +ret = nf90_close(ncid) +end subroutine nc_close_file + + +subroutine nc_define_var_real_1d(ncid, varname, dimname, context, filename) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +character(len=*), intent(in) :: dimname +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename + +character(len=*), parameter :: routine = 'nc_define_var_real_1d' +integer :: ret, dimid, varid + +ret = nf90_inq_dimid(ncid, dimname, dimid) +ret = nf90_def_var(ncid, varname, nf90_real, dimid, varid) + +end subroutine nc_define_var_real_1d + + +subroutine nc_get_real_3d(ncid, varname, varvals, context, filename, & + nc_start, nc_count, nc_stride, nc_map) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +real(4), intent(out) :: varvals(:,:,:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename +integer, intent(in), optional :: nc_start(:) +integer, intent(in), optional :: nc_count(:) +integer, intent(in), optional :: nc_stride(:) +integer, intent(in), optional :: nc_map(:) + +character(len=*), parameter :: routine = 'nc_get_real_3d' +integer :: ret, varid + +ret = nf90_inq_varid(ncid, varname, varid) +ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) + +end subroutine nc_get_real_3d + + +subroutine nc_get_real_2d(ncid, varname, varvals, context, filename, & + nc_start, nc_count, nc_stride, nc_map) +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +real(4), intent(out) :: varvals(:,:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename +integer, intent(in), optional :: nc_start(:) +integer, intent(in), optional :: nc_count(:) +integer, intent(in), optional :: nc_stride(:) +integer, intent(in), optional :: nc_map(:) + +character(len=*), parameter :: routine = 'nc_get_real_2d' +integer :: ret, varid + +ret = nf90_inq_varid(ncid, varname, varid) +ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) + +end subroutine nc_get_real_2d + + +subroutine nc_get_double_1d(ncid, varname, varvals, context, filename, & + nc_start, nc_count, nc_stride, nc_map) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +real(8), intent(out) :: varvals(:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename +integer, intent(in), optional :: nc_start(:) +integer, intent(in), optional :: nc_count(:) +integer, intent(in), optional :: nc_stride(:) +integer, intent(in), optional :: nc_map(:) + +character(len=*), parameter :: routine = 'nc_get_double_1d' +integer :: ret, varid + +ret = nf90_inq_varid(ncid, varname, varid) + +ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) + +end subroutine nc_get_double_1d + + +subroutine nc_put_double_1d(ncid, varname, varvals, context, filename, & + nc_start, nc_count, nc_stride, nc_map) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +real(8), intent(in) :: varvals(:) +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename +integer, intent(in), optional :: nc_start(:) +integer, intent(in), optional :: nc_count(:) +integer, intent(in), optional :: nc_stride(:) +integer, intent(in), optional :: nc_map(:) + +character(len=*), parameter :: routine = 'nc_put_double_1d' +integer :: ret, varid + +ret = nf90_inq_varid(ncid, varname, varid) + +ret = nf90_put_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) + +end subroutine nc_put_double_1d + + +subroutine nc_define_var_double_1d(ncid, varname, dimname, context, filename) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: varname +character(len=*), intent(in) :: dimname +character(len=*), intent(in), optional :: context +character(len=*), intent(in), optional :: filename + +character(len=*), parameter :: routine = 'nc_define_var_double_1d' +integer :: ret, dimid, varid + +ret = nf90_inq_dimid(ncid, dimname, dimid) + +ret = nf90_def_var(ncid, varname, nf90_double, dimid, varid) + +end subroutine nc_define_var_double_1d + + + +end module netcdf_test + + +program nc_reduce + +use netcdf_test + +implicit none +integer :: ncid, status, new_ncid +character(len=NF90_MAX_NAME) :: varname, new_name +integer, parameter :: ndim_3d=3 +integer, parameter :: ndim_2d=2 +real(4), allocatable :: psal(:,:,:), ptmp(:,:,:), uvel(:,:,:), vvel(:,:,:) +real(4), allocatable :: no3(:,:,:), po4(:,:,:), o2(:,:,:), phy(:,:,:), alk(:,:,:) +real(4), allocatable :: dic(:,:,:), dop(:,:,:), don(:,:,:), fet(:,:,:) +real(4), allocatable :: eta(:,:), chl(:,:) +real(4), allocatable :: psal_f(:), ptmp_f(:), uvel_f(:), vvel_f(:) +real(4), allocatable :: no3_f(:), po4_f(:), o2_f(:), phy_f(:), alk_f(:) +real(4), allocatable :: dic_f(:), dop_f(:), don_f(:), fet_f(:) +real(4), allocatable :: eta_f(:), chl_f(:) + +! Dimensions +real(4) :: xg(2000), xc(2000), yg(2000), yc(2000) +real(4) :: zc(50) +logical :: fill_var +integer :: ul +integer :: i,j,k ! loop counter +integer :: ct_3d, ct_2d, dimarr_3d_ct, dimarr_2d_ct +integer :: psalsize(ndim_3d), ptmpsize(ndim_3d), uvelsize(ndim_3d) +integer :: vvelsize(ndim_3d), no3size(ndim_3d), po4size(ndim_3d) +integer :: o2size(ndim_3d), physize(ndim_3d), alksize(ndim_3d) +integer :: dicsize(ndim_3d), dopsize(ndim_3d), donsize(ndim_3d), fetsize(ndim_3d) +integer :: etasize(ndim_2d), chlsize(ndim_2d) +real(4), allocatable :: dimarr_3d(:,:) +real(4), allocatable :: dimarr_2d(:,:) +integer, allocatable :: dimind_3d(:,:) +integer, allocatable :: dimind_2d(:,:) + +! The non_nan values in the variable +integer :: non_nan + +ncid = nc_open_file_readonly('mem01.nc') + +call nc_get_real_1d(ncid, 'XC', xc) +call nc_get_real_1d(ncid, 'XG', xg) +call nc_get_real_1d(ncid, 'YC', yc) +call nc_get_real_1d(ncid, 'YG', yg) +call nc_get_real_1d(ncid, 'ZC', zc) + +write(*,*) 'xc' +write(*,*) xc(3) + +write(*,*) 'xg' +write(*,*) xg(3) + +write(*,*) 'yc' +write(*,*) yc(3) + +write(*,*) 'yg' +write(*,*) yg(3) + + +! Get the size, allocate arrays, and assign values. +call nc_get_variable_size_Nd(ncid, 'PSAL', psalsize) +call nc_get_variable_size_Nd(ncid, 'PTMP', ptmpsize) +call nc_get_variable_size_Nd(ncid, 'UVEL', uvelsize) +call nc_get_variable_size_Nd(ncid, 'VVEL', vvelsize) +call nc_get_variable_size_Nd(ncid, 'NO3', no3size) +call nc_get_variable_size_Nd(ncid, 'PO4', po4size) +call nc_get_variable_size_Nd(ncid, 'O2', o2size) +call nc_get_variable_size_Nd(ncid, 'PHY', physize) +call nc_get_variable_size_Nd(ncid, 'ALK', alksize) +call nc_get_variable_size_Nd(ncid, 'DIC', dicsize) +call nc_get_variable_size_Nd(ncid, 'DOP', dopsize) +call nc_get_variable_size_Nd(ncid, 'DON', donsize) +call nc_get_variable_size_Nd(ncid, 'FET', fetsize) +call nc_get_variable_size_Nd(ncid, 'ETA', etasize) +call nc_get_variable_size_Nd(ncid, 'CHL', chlsize) + +allocate(psal(psalsize(1), psalsize(2), psalsize(3))) +call nc_get_real_3d(ncid, 'PSAL', psal) + +allocate(ptmp(ptmpsize(1), ptmpsize(2), ptmpsize(3))) +call nc_get_real_3d(ncid, 'PTMP', ptmp) + +allocate(uvel(uvelsize(1), uvelsize(2), uvelsize(3))) +call nc_get_real_3d(ncid, 'UVEL', uvel) + +allocate(vvel(vvelsize(1), vvelsize(2), vvelsize(3))) +call nc_get_real_3d(ncid, 'VVEL', vvel) + +allocate(no3(no3size(1), no3size(2), no3size(3))) +call nc_get_real_3d(ncid, 'NO3', no3) + +allocate(po4(po4size(1), po4size(2), po4size(3))) +call nc_get_real_3d(ncid, 'PO4', po4) + +allocate(o2(o2size(1), o2size(2), o2size(3))) +call nc_get_real_3d(ncid, 'O2', o2) + +allocate(phy(physize(1), physize(2), physize(3))) +call nc_get_real_3d(ncid, 'PHY', phy) + +allocate(alk(alksize(1), alksize(2), alksize(3))) +call nc_get_real_3d(ncid, 'ALK', alk) + +allocate(dic(dicsize(1), dicsize(2), dicsize(3))) +call nc_get_real_3d(ncid, 'DIC', dic) + +allocate(dop(dopsize(1), dopsize(2), dopsize(3))) +call nc_get_real_3d(ncid, 'DOP', dop) + +allocate(don(donsize(1), donsize(2), donsize(3))) +call nc_get_real_3d(ncid, 'DON', don) + +allocate(fet(fetsize(1), fetsize(2), fetsize(3))) +call nc_get_real_3d(ncid, 'FET', fet) + +allocate(eta(etasize(1), etasize(2))) +call nc_get_real_2d(ncid, 'ETA', eta) + +allocate(chl(chlsize(1), chlsize(2))) +call nc_get_real_2d(ncid, 'CHL', chl) + +! ul = size(pack(psal, psal /= -999.0)) +! write(*,*) psalsize +! write(*,*) o2size +! write(*,*) etasize + +ct_3d = 0 +ct_2d = 0 +! +! +do i=1,psalsize(1) + do j=1,psalsize(2) + if (chl(i,j) /= -999.) then + ct_2d = ct_2d + 1 + endif + do k=1,psalsize(3) + if (psal(i,j,k) /= -999.) then + ct_3d = ct_3d + 1 + endif + enddo + enddo +enddo + +allocate(dimarr_3d(ct_3d, 3)) +allocate(dimarr_2d(ct_2d, 2)) +allocate(dimind_3d(ct_3d, 3)) +allocate(dimind_2d(ct_2d, 2)) + +allocate(psal_f(ct_3d)) +allocate(ptmp_f(ct_3d)) +allocate(uvel_f(ct_3d)) +allocate(vvel_f(ct_3d)) +allocate(no3_f(ct_3d)) +allocate(po4_f(ct_3d)) +allocate(o2_f(ct_3d)) +allocate(phy_f(ct_3d)) +allocate(alk_f(ct_3d)) +allocate(dic_f(ct_3d)) +allocate(dop_f(ct_3d)) +allocate(don_f(ct_3d)) +allocate(fet_f(ct_3d)) +allocate(chl_f(ct_2d)) +allocate(eta_f(ct_2d)) + + +dimarr_3d_ct = 1 +dimarr_2d_ct = 1 + +! > EL change 06/23: make the depth the outer loop for this. This will make sure the 2d components +! > are the first terms of the 3d components. +do k=1,psalsize(3) + do i=1,psalsize(1) + do j=1,psalsize(2) + if (psal(i,j,k) /= -999.) then + dimarr_3d(dimarr_3d_ct, 1) = xc(i) + dimarr_3d(dimarr_3d_ct, 2) = yc(j) + dimarr_3d(dimarr_3d_ct, 3) = zc(k) + dimind_3d(dimarr_3d_ct, 1) = i + dimind_3d(dimarr_3d_ct, 2) = j + dimind_3d(dimarr_3d_ct, 3) = k + + psal_f(dimarr_3d_ct) = psal(i,j,k) + ptmp_f(dimarr_3d_ct) = ptmp(i,j,k) + uvel_f(dimarr_3d_ct) = uvel(i,j,k) + vvel_f(dimarr_3d_ct) = vvel(i,j,k) + no3_f(dimarr_3d_ct) = no3(i,j,k) + po4_f(dimarr_3d_ct) = po4(i,j,k) + o2_f(dimarr_3d_ct) = o2(i,j,k) + phy_f(dimarr_3d_ct) = phy(i,j,k) + alk_f(dimarr_3d_ct) = alk(i,j,k) + dic_f(dimarr_3d_ct) = dic(i,j,k) + dop_f(dimarr_3d_ct) = dop(i,j,k) + don_f(dimarr_3d_ct) = don(i,j,k) + fet_f(dimarr_3d_ct) = fet(i,j,k) + dimarr_3d_ct = dimarr_3d_ct + 1 + endif + enddo + enddo +enddo + +do i=1,chlsize(1) + do j=1,chlsize(2) + if (chl(i,j) /= -999.) then + dimarr_2d(dimarr_2d_ct, 1) = xc(i) + dimarr_2d(dimarr_2d_ct, 2) = yc(j) + + dimind_2d(dimarr_2d_ct, 1) = i + dimind_2d(dimarr_2d_ct, 2) = j + eta_f(dimarr_2d_ct) = eta(i,j) + chl_f(dimarr_2d_ct) = chl(i,j) + + dimarr_2d_ct = dimarr_2d_ct + 1 + endif + enddo +enddo + +write(*,*) '3d_values' +write(*,*) no3_f(154311) +write(*,*) dimarr_3d(154311, :) +write(*,*) dimind_3d(154311, :) +write(*,*) '2d_values' +write(*,*) chl_f(154311) +write(*,*) dimarr_2d(154311,:) +write(*,*) dimind_2d(154311, :) +! +write(*,*) 'original values' +! write(*,*) no3(254,1214,1) +write(*,*) chl(781,1205) + +write(*,*) '1-d values' +write(*,*) + +! Start creating the new netcdf and define the new 1-d dimension. +new_name = 'output_mem01.nc' +status = nf90_create(new_name, NF90_CLOBBER, new_ncid) +call nc_define_dimension(new_ncid, 'useful_info_3d', ct_3d) +call nc_define_dimension(new_ncid, 'useful_info_2d', ct_2d) + +! Put all the (new) variables in +call nc_define_var_real_1d(new_ncid, 'PSAL', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'PTMP', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'UVEL', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'VVEL', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'ETA', 'useful_info_2d') +call nc_define_var_real_1d(new_ncid, 'NO3', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'PO4', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'O2', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'PHY', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'ALK', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'DIC', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'DOP', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'DON', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'FET', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'CHL', 'useful_info_2d') +call nc_define_var_real_1d(new_ncid, 'XC_3D', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'XC_2D', 'useful_info_2d') +call nc_define_var_real_1d(new_ncid, 'YC_3D', 'useful_info_3d') +call nc_define_var_real_1d(new_ncid, 'YC_2D', 'useful_info_2d') +call nc_define_var_real_1d(new_ncid, 'ZC_3D', 'useful_info_3d') + +! Close the file +call nc_close_file(new_ncid) + +! Write the information +status = nc_open_file_readwrite(new_name) +call nc_put_real_1d(new_ncid, 'PSAL', psal_f) +call nc_put_real_1d(new_ncid, 'PTMP', ptmp_f) +call nc_put_real_1d(new_ncid, 'UVEL', uvel_f) +call nc_put_real_1d(new_ncid, 'VVEL', vvel_f) +call nc_put_real_1d(new_ncid, 'ETA', eta_f) +call nc_put_real_1d(new_ncid, 'NO3', no3_f) +call nc_put_real_1d(new_ncid, 'PO4', po4_f) +call nc_put_real_1d(new_ncid, 'O2', o2_f) +call nc_put_real_1d(new_ncid, 'PHY', phy_f) +call nc_put_real_1d(new_ncid, 'ALK', alk_f) +call nc_put_real_1d(new_ncid, 'DIC', dic_f) +call nc_put_real_1d(new_ncid, 'DOP', dop_f) +call nc_put_real_1d(new_ncid, 'DON', don_f) +call nc_put_real_1d(new_ncid, 'FET', fet_f) +call nc_put_real_1d(new_ncid, 'CHL', chl_f) +call nc_put_real_1d(new_ncid, 'XC_3D', dimarr_3d(:, 1)) +call nc_put_real_1d(new_ncid, 'YC_3D', dimarr_3d(:, 2)) +call nc_put_real_1d(new_ncid, 'ZC_3D', dimarr_3d(:, 3)) +call nc_put_real_1d(new_ncid, 'XC_2D', dimarr_2d(:, 1)) +call nc_put_real_1d(new_ncid, 'YC_2D', dimarr_2d(:, 2)) + + +call nc_close_file(new_ncid) + +! Start writing the results: + + +end program nc_reduce diff --git a/models/MITgcm_ocean/work/input.nml b/models/MITgcm_ocean/work/input.nml index 7b6c2be034..931fcc3d34 100644 --- a/models/MITgcm_ocean/work/input.nml +++ b/models/MITgcm_ocean/work/input.nml @@ -458,7 +458,7 @@ # quantity_of_interest = 'QTY_DENSITY' &model_mod_check_nml - input_state_files = 'OUTPUT.nc' + input_state_files = 'mem01_reduced.nc' output_state_files = 'check_me' verbose = .TRUE. test1thru = 0 From 7d5867f6167b17916e79990c9e554a0891daf676 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 16 Aug 2022 14:22:31 -0600 Subject: [PATCH 005/124] moved dart_nc_reduce one directory up to compile --- models/MITgcm_ocean/{work => }/dart_nc_reduce.f90 | 0 models/MITgcm_ocean/work/quickbuild.sh | 1 + 2 files changed, 1 insertion(+) rename models/MITgcm_ocean/{work => }/dart_nc_reduce.f90 (100%) diff --git a/models/MITgcm_ocean/work/dart_nc_reduce.f90 b/models/MITgcm_ocean/dart_nc_reduce.f90 similarity index 100% rename from models/MITgcm_ocean/work/dart_nc_reduce.f90 rename to models/MITgcm_ocean/dart_nc_reduce.f90 diff --git a/models/MITgcm_ocean/work/quickbuild.sh b/models/MITgcm_ocean/work/quickbuild.sh index 80731cfd82..1a83d71483 100755 --- a/models/MITgcm_ocean/work/quickbuild.sh +++ b/models/MITgcm_ocean/work/quickbuild.sh @@ -34,6 +34,7 @@ model_serial_programs=( dart_to_mit mit_to_dart create_ocean_obs +dart_nc_reduce ) arguments "$@" From d376f80dfb17388c481996c442964c4d25f8ed40 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 16 Aug 2022 20:09:16 -0600 Subject: [PATCH 006/124] grid size is harded coded - change to small case todo: use dart modules rather than standalone, netcdf, kinds, etc --- models/MITgcm_ocean/dart_nc_reduce.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/models/MITgcm_ocean/dart_nc_reduce.f90 b/models/MITgcm_ocean/dart_nc_reduce.f90 index a2aa9b119d..c19f1feb44 100644 --- a/models/MITgcm_ocean/dart_nc_reduce.f90 +++ b/models/MITgcm_ocean/dart_nc_reduce.f90 @@ -385,7 +385,8 @@ program nc_reduce real(4), allocatable :: eta_f(:), chl_f(:) ! Dimensions -real(4) :: xg(2000), xc(2000), yg(2000), yc(2000) +!real(4) :: xg(2000), xc(2000), yg(2000), yc(2000) +real(4) :: xg(500), xc(500), yg(500), yc(500) real(4) :: zc(50) logical :: fill_var integer :: ul From 869d89d867f283801fab107d14473ca7099e2a29 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 17 Aug 2022 09:27:38 -0600 Subject: [PATCH 007/124] using dart netcdf utilites and types modules --- models/MITgcm_ocean/dart_nc_reduce.f90 | 683 ++++++------------------- 1 file changed, 155 insertions(+), 528 deletions(-) diff --git a/models/MITgcm_ocean/dart_nc_reduce.f90 b/models/MITgcm_ocean/dart_nc_reduce.f90 index c19f1feb44..29570d8544 100644 --- a/models/MITgcm_ocean/dart_nc_reduce.f90 +++ b/models/MITgcm_ocean/dart_nc_reduce.f90 @@ -1,395 +1,37 @@ -module netcdf_test - -use netcdf -contains - -function nc_open_file_readonly(filename, context) - -character(len=*), intent(in) :: filename -character(len=*), intent(in), optional :: context -integer :: nc_open_file_readonly - -character(len=*), parameter :: routine = 'nc_open_file_readonly' -integer :: ret, ncid - -ret = nf90_open(filename, NF90_NOWRITE, ncid) -nc_open_file_readonly = ncid - -end function nc_open_file_readonly - - -subroutine nc_define_var_int_Nd(ncid, varname, dimnames, context, filename) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -character(len=*), intent(in) :: dimnames(:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename - -character(len=*), parameter :: routine = 'nc_define_var_int_Nd' -integer :: i, ret, ndims, varid, dimids(NF90_MAX_VAR_DIMS) - -ndims = size(dimnames) - -do i=1, ndims - ret = nf90_inq_dimid(ncid, dimnames(i), dimids(i)) -enddo - -ret = nf90_def_var(ncid, varname, nf90_int, dimids(1:ndims), varid=varid) - -end subroutine nc_define_var_int_Nd - - -function nc_create_file(filename, context) - -character(len=*), intent(in) :: filename -character(len=*), intent(in), optional :: context -integer :: nc_create_file - -character(len=*), parameter :: routine = 'nc_create_file' -integer :: ret, ncid, oldmode - -ret = nf90_create(filename, NF90_CLOBBER, ncid) -nc_create_file = ncid - -! faster if we don't fill the vars first with 'fill' value. -! this works if we are planning to write all vars. (which we are.) - -ret = nf90_set_fill(ncid, NF90_NOFILL, oldmode) - -end function nc_create_file - - -subroutine nc_get_variable_size_Nd(ncid, varname, varsize, context, filename) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -integer, intent(out) :: varsize(:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename - -character(len=*), parameter :: routine = 'nc_get_variable_size_Nd' -integer :: ret, i, ndims, varid, dimids(NF90_MAX_VAR_DIMS) - - -ret = nf90_inq_varid(ncid, varname, varid) - -ret = nf90_inquire_variable(ncid, varid, dimids=dimids, ndims=ndims) - -! if (ndims > size(varsize)) & -! call nc_check(NF90_EDIMSIZE, routine, 'variable '//trim(varname)//' return varsize array too small', & -! context, filename, ncid) -! -! ! in case the var is larger than ndims, set unused dims to -1 -! varsize(:) = -1 -do i=1, ndims - ret = nf90_inquire_dimension(ncid, dimids(i), len=varsize(i)) -enddo - -end subroutine nc_get_variable_size_Nd - - -subroutine nc_get_double_4d(ncid, varname, varvals, context, filename, & - nc_start, nc_count, nc_stride, nc_map) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -real(8), intent(out) :: varvals(:,:,:,:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename -integer, intent(in), optional :: nc_start(:) -integer, intent(in), optional :: nc_count(:) -integer, intent(in), optional :: nc_stride(:) -integer, intent(in), optional :: nc_map(:) - -character(len=*), parameter :: routine = 'nc_get_double_4d' -integer :: ret, varid - -ret = nf90_inq_varid(ncid, varname, varid) -ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) - -end subroutine nc_get_double_4d - - -subroutine nc_get_real_1d(ncid, varname, varvals, context, filename, & - nc_start, nc_count, nc_stride, nc_map) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -real(4), intent(out) :: varvals(:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename -integer, intent(in), optional :: nc_start(:) -integer, intent(in), optional :: nc_count(:) -integer, intent(in), optional :: nc_stride(:) -integer, intent(in), optional :: nc_map(:) - -character(len=*), parameter :: routine = 'nc_get_real_1d' -integer :: ret, varid - -ret = nf90_inq_varid(ncid, varname, varid) -ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) - -end subroutine nc_get_real_1d - - -subroutine nc_get_variable_size_1d(ncid, varname, varsize, context, filename) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -integer, intent(out) :: varsize -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename - -character(len=*), parameter :: routine = 'nc_get_variable_size_1d' -integer :: ret, ndims, varid, dimids(NF90_MAX_VAR_DIMS) - -ret = nf90_inq_varid(ncid, varname, varid) -ret = nf90_inquire_variable(ncid, varid, dimids=dimids, ndims=ndims) -ret = nf90_inquire_dimension(ncid, dimids(1), len=varsize) - -end subroutine nc_get_variable_size_1d - - -subroutine nc_put_real_1d(ncid, varname, varvals, context, filename, & - nc_start, nc_count, nc_stride, nc_map) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -real(4), intent(in) :: varvals(:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename -integer, intent(in), optional :: nc_start(:) -integer, intent(in), optional :: nc_count(:) -integer, intent(in), optional :: nc_stride(:) -integer, intent(in), optional :: nc_map(:) - -character(len=*), parameter :: routine = 'nc_put_real_1d' -integer :: ret, varid - -ret = nf90_inq_varid(ncid, varname, varid) -ret = nf90_put_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) - -end subroutine nc_put_real_1d - - -subroutine nc_define_dimension(ncid, dimname, dimlen, context, filename) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: dimname -integer, intent(in) :: dimlen -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename - -character(len=*), parameter :: routine = 'nc_define_dimension' -integer :: ret, dimid - -ret = nf90_def_dim(ncid, dimname, dimlen, dimid) - -end subroutine nc_define_dimension - -!-------------------------------------------------------------------- - -subroutine nc_define_unlimited_dimension(ncid, dimname, context, filename) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: dimname -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename - -character(len=*), parameter :: routine = 'nc_define_unlimited_dimension' -integer :: ret, dimid - -ret = nf90_def_dim(ncid, dimname, NF90_UNLIMITED, dimid) - -end subroutine nc_define_unlimited_dimension - - -function nc_open_file_readwrite(filename, context) - -character(len=*), intent(in) :: filename -character(len=*), intent(in), optional :: context -integer :: nc_open_file_readwrite - -character(len=*), parameter :: routine = 'nc_open_file_readwrite' -integer :: ret, ncid, oldmode - -ret = nf90_open(filename, NF90_WRITE, ncid) -nc_open_file_readwrite = ncid - -! faster if we don't fill the vars first with 'fill' value. -! this works if we are planning to write all vars. (which we are.) - -ret = nf90_set_fill(ncid, NF90_NOFILL, oldmode) - -end function nc_open_file_readwrite - - -subroutine nc_close_file(ncid, context, filename) - -integer, intent(in) :: ncid -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename - -character(len=*), parameter :: routine = 'nc_close_file' -integer :: ret - -ret = nf90_close(ncid) -end subroutine nc_close_file - - -subroutine nc_define_var_real_1d(ncid, varname, dimname, context, filename) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -character(len=*), intent(in) :: dimname -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename - -character(len=*), parameter :: routine = 'nc_define_var_real_1d' -integer :: ret, dimid, varid - -ret = nf90_inq_dimid(ncid, dimname, dimid) -ret = nf90_def_var(ncid, varname, nf90_real, dimid, varid) - -end subroutine nc_define_var_real_1d - - -subroutine nc_get_real_3d(ncid, varname, varvals, context, filename, & - nc_start, nc_count, nc_stride, nc_map) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -real(4), intent(out) :: varvals(:,:,:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename -integer, intent(in), optional :: nc_start(:) -integer, intent(in), optional :: nc_count(:) -integer, intent(in), optional :: nc_stride(:) -integer, intent(in), optional :: nc_map(:) - -character(len=*), parameter :: routine = 'nc_get_real_3d' -integer :: ret, varid - -ret = nf90_inq_varid(ncid, varname, varid) -ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) - -end subroutine nc_get_real_3d - - -subroutine nc_get_real_2d(ncid, varname, varvals, context, filename, & - nc_start, nc_count, nc_stride, nc_map) -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -real(4), intent(out) :: varvals(:,:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename -integer, intent(in), optional :: nc_start(:) -integer, intent(in), optional :: nc_count(:) -integer, intent(in), optional :: nc_stride(:) -integer, intent(in), optional :: nc_map(:) - -character(len=*), parameter :: routine = 'nc_get_real_2d' -integer :: ret, varid - -ret = nf90_inq_varid(ncid, varname, varid) -ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) - -end subroutine nc_get_real_2d - - -subroutine nc_get_double_1d(ncid, varname, varvals, context, filename, & - nc_start, nc_count, nc_stride, nc_map) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -real(8), intent(out) :: varvals(:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename -integer, intent(in), optional :: nc_start(:) -integer, intent(in), optional :: nc_count(:) -integer, intent(in), optional :: nc_stride(:) -integer, intent(in), optional :: nc_map(:) - -character(len=*), parameter :: routine = 'nc_get_double_1d' -integer :: ret, varid - -ret = nf90_inq_varid(ncid, varname, varid) - -ret = nf90_get_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) - -end subroutine nc_get_double_1d - - -subroutine nc_put_double_1d(ncid, varname, varvals, context, filename, & - nc_start, nc_count, nc_stride, nc_map) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -real(8), intent(in) :: varvals(:) -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename -integer, intent(in), optional :: nc_start(:) -integer, intent(in), optional :: nc_count(:) -integer, intent(in), optional :: nc_stride(:) -integer, intent(in), optional :: nc_map(:) - -character(len=*), parameter :: routine = 'nc_put_double_1d' -integer :: ret, varid - -ret = nf90_inq_varid(ncid, varname, varid) - -ret = nf90_put_var(ncid, varid, varvals, nc_start, nc_count, nc_stride, nc_map) - -end subroutine nc_put_double_1d - - -subroutine nc_define_var_double_1d(ncid, varname, dimname, context, filename) - -integer, intent(in) :: ncid -character(len=*), intent(in) :: varname -character(len=*), intent(in) :: dimname -character(len=*), intent(in), optional :: context -character(len=*), intent(in), optional :: filename - -character(len=*), parameter :: routine = 'nc_define_var_double_1d' -integer :: ret, dimid, varid - -ret = nf90_inq_dimid(ncid, dimname, dimid) - -ret = nf90_def_var(ncid, varname, nf90_double, dimid, varid) +program nc_reduce -end subroutine nc_define_var_double_1d +use netcdf_utilities_mod, only : nc_get_variable, nc_define_dimension, nc_define_real_variable, & + nc_put_variable, nc_check, nc_open_file_readonly, & + nc_open_file_readwrite, nc_close_file, nc_create_file, & + nc_get_variable_size +use types_mod, only : r4 +use utilities_mod, only : initialize_utilities, finalize_utilities -end module netcdf_test +use netcdf +implicit none -program nc_reduce +integer :: ncid, ret, new_ncid +character(len=NF90_MAX_NAME) :: new_name -use netcdf_test -implicit none -integer :: ncid, status, new_ncid -character(len=NF90_MAX_NAME) :: varname, new_name integer, parameter :: ndim_3d=3 integer, parameter :: ndim_2d=2 -real(4), allocatable :: psal(:,:,:), ptmp(:,:,:), uvel(:,:,:), vvel(:,:,:) -real(4), allocatable :: no3(:,:,:), po4(:,:,:), o2(:,:,:), phy(:,:,:), alk(:,:,:) -real(4), allocatable :: dic(:,:,:), dop(:,:,:), don(:,:,:), fet(:,:,:) -real(4), allocatable :: eta(:,:), chl(:,:) -real(4), allocatable :: psal_f(:), ptmp_f(:), uvel_f(:), vvel_f(:) -real(4), allocatable :: no3_f(:), po4_f(:), o2_f(:), phy_f(:), alk_f(:) -real(4), allocatable :: dic_f(:), dop_f(:), don_f(:), fet_f(:) -real(4), allocatable :: eta_f(:), chl_f(:) +real(r4), allocatable :: psal(:,:,:), ptmp(:,:,:), uvel(:,:,:), vvel(:,:,:) +real(r4), allocatable :: no3(:,:,:), po4(:,:,:), o2(:,:,:), phy(:,:,:), alk(:,:,:) +real(r4), allocatable :: dic(:,:,:), dop(:,:,:), don(:,:,:), fet(:,:,:) +real(r4), allocatable :: eta(:,:), chl(:,:) +real(r4), allocatable :: psal_f(:), ptmp_f(:), uvel_f(:), vvel_f(:) +real(r4), allocatable :: no3_f(:), po4_f(:), o2_f(:), phy_f(:), alk_f(:) +real(r4), allocatable :: dic_f(:), dop_f(:), don_f(:), fet_f(:) +real(r4), allocatable :: eta_f(:), chl_f(:) ! Dimensions -!real(4) :: xg(2000), xc(2000), yg(2000), yc(2000) -real(4) :: xg(500), xc(500), yg(500), yc(500) -real(4) :: zc(50) -logical :: fill_var -integer :: ul +!real(r4) :: xg(2000), xc(2000), yg(2000), yc(2000) +real(r4) :: xg(500), xc(500), yg(500), yc(500) +real(r4) :: zc(50) integer :: i,j,k ! loop counter integer :: ct_3d, ct_2d, dimarr_3d_ct, dimarr_2d_ct integer :: psalsize(ndim_3d), ptmpsize(ndim_3d), uvelsize(ndim_3d) @@ -397,21 +39,21 @@ program nc_reduce integer :: o2size(ndim_3d), physize(ndim_3d), alksize(ndim_3d) integer :: dicsize(ndim_3d), dopsize(ndim_3d), donsize(ndim_3d), fetsize(ndim_3d) integer :: etasize(ndim_2d), chlsize(ndim_2d) -real(4), allocatable :: dimarr_3d(:,:) -real(4), allocatable :: dimarr_2d(:,:) +real(r4), allocatable :: dimarr_3d(:,:) +real(r4), allocatable :: dimarr_2d(:,:) integer, allocatable :: dimind_3d(:,:) integer, allocatable :: dimind_2d(:,:) -! The non_nan values in the variable -integer :: non_nan + +call initialize_utilities('dart_nc_reduce') ncid = nc_open_file_readonly('mem01.nc') -call nc_get_real_1d(ncid, 'XC', xc) -call nc_get_real_1d(ncid, 'XG', xg) -call nc_get_real_1d(ncid, 'YC', yc) -call nc_get_real_1d(ncid, 'YG', yg) -call nc_get_real_1d(ncid, 'ZC', zc) +call nc_get_variable(ncid, 'XC', xc) +call nc_get_variable(ncid, 'XG', xg) +call nc_get_variable(ncid, 'YC', yc) +call nc_get_variable(ncid, 'YG', yg) +call nc_get_variable(ncid, 'ZC', zc) write(*,*) 'xc' write(*,*) xc(3) @@ -427,66 +69,66 @@ program nc_reduce ! Get the size, allocate arrays, and assign values. -call nc_get_variable_size_Nd(ncid, 'PSAL', psalsize) -call nc_get_variable_size_Nd(ncid, 'PTMP', ptmpsize) -call nc_get_variable_size_Nd(ncid, 'UVEL', uvelsize) -call nc_get_variable_size_Nd(ncid, 'VVEL', vvelsize) -call nc_get_variable_size_Nd(ncid, 'NO3', no3size) -call nc_get_variable_size_Nd(ncid, 'PO4', po4size) -call nc_get_variable_size_Nd(ncid, 'O2', o2size) -call nc_get_variable_size_Nd(ncid, 'PHY', physize) -call nc_get_variable_size_Nd(ncid, 'ALK', alksize) -call nc_get_variable_size_Nd(ncid, 'DIC', dicsize) -call nc_get_variable_size_Nd(ncid, 'DOP', dopsize) -call nc_get_variable_size_Nd(ncid, 'DON', donsize) -call nc_get_variable_size_Nd(ncid, 'FET', fetsize) -call nc_get_variable_size_Nd(ncid, 'ETA', etasize) -call nc_get_variable_size_Nd(ncid, 'CHL', chlsize) +call nc_get_variable_size(ncid, 'PSAL', psalsize) +call nc_get_variable_size(ncid, 'PTMP', ptmpsize) +call nc_get_variable_size(ncid, 'UVEL', uvelsize) +call nc_get_variable_size(ncid, 'VVEL', vvelsize) +call nc_get_variable_size(ncid, 'NO3', no3size) +call nc_get_variable_size(ncid, 'PO4', po4size) +call nc_get_variable_size(ncid, 'O2', o2size) +call nc_get_variable_size(ncid, 'PHY', physize) +call nc_get_variable_size(ncid, 'ALK', alksize) +call nc_get_variable_size(ncid, 'DIC', dicsize) +call nc_get_variable_size(ncid, 'DOP', dopsize) +call nc_get_variable_size(ncid, 'DON', donsize) +call nc_get_variable_size(ncid, 'FET', fetsize) +call nc_get_variable_size(ncid, 'ETA', etasize) +call nc_get_variable_size(ncid, 'CHL', chlsize) allocate(psal(psalsize(1), psalsize(2), psalsize(3))) -call nc_get_real_3d(ncid, 'PSAL', psal) +call nc_get_variable(ncid, 'PSAL', psal) allocate(ptmp(ptmpsize(1), ptmpsize(2), ptmpsize(3))) -call nc_get_real_3d(ncid, 'PTMP', ptmp) +call nc_get_variable(ncid, 'PTMP', ptmp) allocate(uvel(uvelsize(1), uvelsize(2), uvelsize(3))) -call nc_get_real_3d(ncid, 'UVEL', uvel) +call nc_get_variable(ncid, 'UVEL', uvel) allocate(vvel(vvelsize(1), vvelsize(2), vvelsize(3))) -call nc_get_real_3d(ncid, 'VVEL', vvel) +call nc_get_variable(ncid, 'VVEL', vvel) allocate(no3(no3size(1), no3size(2), no3size(3))) -call nc_get_real_3d(ncid, 'NO3', no3) +call nc_get_variable(ncid, 'NO3', no3) allocate(po4(po4size(1), po4size(2), po4size(3))) -call nc_get_real_3d(ncid, 'PO4', po4) +call nc_get_variable(ncid, 'PO4', po4) allocate(o2(o2size(1), o2size(2), o2size(3))) -call nc_get_real_3d(ncid, 'O2', o2) +call nc_get_variable(ncid, 'O2', o2) allocate(phy(physize(1), physize(2), physize(3))) -call nc_get_real_3d(ncid, 'PHY', phy) +call nc_get_variable(ncid, 'PHY', phy) allocate(alk(alksize(1), alksize(2), alksize(3))) -call nc_get_real_3d(ncid, 'ALK', alk) +call nc_get_variable(ncid, 'ALK', alk) allocate(dic(dicsize(1), dicsize(2), dicsize(3))) -call nc_get_real_3d(ncid, 'DIC', dic) +call nc_get_variable(ncid, 'DIC', dic) allocate(dop(dopsize(1), dopsize(2), dopsize(3))) -call nc_get_real_3d(ncid, 'DOP', dop) +call nc_get_variable(ncid, 'DOP', dop) allocate(don(donsize(1), donsize(2), donsize(3))) -call nc_get_real_3d(ncid, 'DON', don) +call nc_get_variable(ncid, 'DON', don) allocate(fet(fetsize(1), fetsize(2), fetsize(3))) -call nc_get_real_3d(ncid, 'FET', fet) +call nc_get_variable(ncid, 'FET', fet) allocate(eta(etasize(1), etasize(2))) -call nc_get_real_2d(ncid, 'ETA', eta) +call nc_get_variable(ncid, 'ETA', eta) allocate(chl(chlsize(1), chlsize(2))) -call nc_get_real_2d(ncid, 'CHL', chl) +call nc_get_variable(ncid, 'CHL', chl) ! ul = size(pack(psal, psal /= -999.0)) ! write(*,*) psalsize @@ -498,16 +140,16 @@ program nc_reduce ! ! do i=1,psalsize(1) - do j=1,psalsize(2) - if (chl(i,j) /= -999.) then - ct_2d = ct_2d + 1 - endif - do k=1,psalsize(3) - if (psal(i,j,k) /= -999.) then - ct_3d = ct_3d + 1 - endif - enddo - enddo + do j=1,psalsize(2) + if (chl(i,j) /= -999.) then + ct_2d = ct_2d + 1 + endif + do k=1,psalsize(3) + if (psal(i,j,k) /= -999.) then + ct_3d = ct_3d + 1 + endif + enddo + enddo enddo allocate(dimarr_3d(ct_3d, 3)) @@ -538,125 +180,110 @@ program nc_reduce ! > EL change 06/23: make the depth the outer loop for this. This will make sure the 2d components ! > are the first terms of the 3d components. do k=1,psalsize(3) - do i=1,psalsize(1) - do j=1,psalsize(2) - if (psal(i,j,k) /= -999.) then - dimarr_3d(dimarr_3d_ct, 1) = xc(i) - dimarr_3d(dimarr_3d_ct, 2) = yc(j) - dimarr_3d(dimarr_3d_ct, 3) = zc(k) - dimind_3d(dimarr_3d_ct, 1) = i - dimind_3d(dimarr_3d_ct, 2) = j - dimind_3d(dimarr_3d_ct, 3) = k - - psal_f(dimarr_3d_ct) = psal(i,j,k) - ptmp_f(dimarr_3d_ct) = ptmp(i,j,k) - uvel_f(dimarr_3d_ct) = uvel(i,j,k) - vvel_f(dimarr_3d_ct) = vvel(i,j,k) - no3_f(dimarr_3d_ct) = no3(i,j,k) - po4_f(dimarr_3d_ct) = po4(i,j,k) - o2_f(dimarr_3d_ct) = o2(i,j,k) - phy_f(dimarr_3d_ct) = phy(i,j,k) - alk_f(dimarr_3d_ct) = alk(i,j,k) - dic_f(dimarr_3d_ct) = dic(i,j,k) - dop_f(dimarr_3d_ct) = dop(i,j,k) - don_f(dimarr_3d_ct) = don(i,j,k) - fet_f(dimarr_3d_ct) = fet(i,j,k) - dimarr_3d_ct = dimarr_3d_ct + 1 - endif - enddo - enddo + do i=1,psalsize(1) + do j=1,psalsize(2) + if (psal(i,j,k) /= -999.) then + dimarr_3d(dimarr_3d_ct, 1) = xc(i) + dimarr_3d(dimarr_3d_ct, 2) = yc(j) + dimarr_3d(dimarr_3d_ct, 3) = zc(k) + dimind_3d(dimarr_3d_ct, 1) = i + dimind_3d(dimarr_3d_ct, 2) = j + dimind_3d(dimarr_3d_ct, 3) = k + + psal_f(dimarr_3d_ct) = psal(i,j,k) + ptmp_f(dimarr_3d_ct) = ptmp(i,j,k) + uvel_f(dimarr_3d_ct) = uvel(i,j,k) + vvel_f(dimarr_3d_ct) = vvel(i,j,k) + no3_f(dimarr_3d_ct) = no3(i,j,k) + po4_f(dimarr_3d_ct) = po4(i,j,k) + o2_f(dimarr_3d_ct) = o2(i,j,k) + phy_f(dimarr_3d_ct) = phy(i,j,k) + alk_f(dimarr_3d_ct) = alk(i,j,k) + dic_f(dimarr_3d_ct) = dic(i,j,k) + dop_f(dimarr_3d_ct) = dop(i,j,k) + don_f(dimarr_3d_ct) = don(i,j,k) + fet_f(dimarr_3d_ct) = fet(i,j,k) + dimarr_3d_ct = dimarr_3d_ct + 1 + endif + enddo + enddo enddo do i=1,chlsize(1) - do j=1,chlsize(2) - if (chl(i,j) /= -999.) then - dimarr_2d(dimarr_2d_ct, 1) = xc(i) - dimarr_2d(dimarr_2d_ct, 2) = yc(j) - - dimind_2d(dimarr_2d_ct, 1) = i - dimind_2d(dimarr_2d_ct, 2) = j - eta_f(dimarr_2d_ct) = eta(i,j) - chl_f(dimarr_2d_ct) = chl(i,j) - - dimarr_2d_ct = dimarr_2d_ct + 1 - endif - enddo + do j=1,chlsize(2) + if (chl(i,j) /= -999.) then + dimarr_2d(dimarr_2d_ct, 1) = xc(i) + dimarr_2d(dimarr_2d_ct, 2) = yc(j) + + dimind_2d(dimarr_2d_ct, 1) = i + dimind_2d(dimarr_2d_ct, 2) = j + eta_f(dimarr_2d_ct) = eta(i,j) + chl_f(dimarr_2d_ct) = chl(i,j) + + dimarr_2d_ct = dimarr_2d_ct + 1 + endif + enddo enddo -write(*,*) '3d_values' -write(*,*) no3_f(154311) -write(*,*) dimarr_3d(154311, :) -write(*,*) dimind_3d(154311, :) -write(*,*) '2d_values' -write(*,*) chl_f(154311) -write(*,*) dimarr_2d(154311,:) -write(*,*) dimind_2d(154311, :) -! -write(*,*) 'original values' -! write(*,*) no3(254,1214,1) -write(*,*) chl(781,1205) - -write(*,*) '1-d values' -write(*,*) ! Start creating the new netcdf and define the new 1-d dimension. new_name = 'output_mem01.nc' -status = nf90_create(new_name, NF90_CLOBBER, new_ncid) +new_ncid = nc_create_file(new_name, 'squished file') +print*, 'ct_3d', ct_3d, 'ct_2d', ct_2d call nc_define_dimension(new_ncid, 'useful_info_3d', ct_3d) call nc_define_dimension(new_ncid, 'useful_info_2d', ct_2d) ! Put all the (new) variables in -call nc_define_var_real_1d(new_ncid, 'PSAL', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'PTMP', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'UVEL', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'VVEL', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'ETA', 'useful_info_2d') -call nc_define_var_real_1d(new_ncid, 'NO3', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'PO4', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'O2', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'PHY', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'ALK', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'DIC', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'DOP', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'DON', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'FET', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'CHL', 'useful_info_2d') -call nc_define_var_real_1d(new_ncid, 'XC_3D', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'XC_2D', 'useful_info_2d') -call nc_define_var_real_1d(new_ncid, 'YC_3D', 'useful_info_3d') -call nc_define_var_real_1d(new_ncid, 'YC_2D', 'useful_info_2d') -call nc_define_var_real_1d(new_ncid, 'ZC_3D', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'PSAL', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'PTMP', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'UVEL', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'VVEL', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'ETA', 'useful_info_2d') +call nc_define_real_variable(new_ncid, 'NO3', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'PO4', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'O2', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'PHY', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'ALK', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'DIC', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'DOP', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'DON', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'FET', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'CHL', 'useful_info_2d') +call nc_define_real_variable(new_ncid, 'XC_3D', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'XC_2D', 'useful_info_2d') +call nc_define_real_variable(new_ncid, 'YC_3D', 'useful_info_3d') +call nc_define_real_variable(new_ncid, 'YC_2D', 'useful_info_2d') +call nc_define_real_variable(new_ncid, 'ZC_3D', 'useful_info_3d') ! Close the file call nc_close_file(new_ncid) ! Write the information -status = nc_open_file_readwrite(new_name) -call nc_put_real_1d(new_ncid, 'PSAL', psal_f) -call nc_put_real_1d(new_ncid, 'PTMP', ptmp_f) -call nc_put_real_1d(new_ncid, 'UVEL', uvel_f) -call nc_put_real_1d(new_ncid, 'VVEL', vvel_f) -call nc_put_real_1d(new_ncid, 'ETA', eta_f) -call nc_put_real_1d(new_ncid, 'NO3', no3_f) -call nc_put_real_1d(new_ncid, 'PO4', po4_f) -call nc_put_real_1d(new_ncid, 'O2', o2_f) -call nc_put_real_1d(new_ncid, 'PHY', phy_f) -call nc_put_real_1d(new_ncid, 'ALK', alk_f) -call nc_put_real_1d(new_ncid, 'DIC', dic_f) -call nc_put_real_1d(new_ncid, 'DOP', dop_f) -call nc_put_real_1d(new_ncid, 'DON', don_f) -call nc_put_real_1d(new_ncid, 'FET', fet_f) -call nc_put_real_1d(new_ncid, 'CHL', chl_f) -call nc_put_real_1d(new_ncid, 'XC_3D', dimarr_3d(:, 1)) -call nc_put_real_1d(new_ncid, 'YC_3D', dimarr_3d(:, 2)) -call nc_put_real_1d(new_ncid, 'ZC_3D', dimarr_3d(:, 3)) -call nc_put_real_1d(new_ncid, 'XC_2D', dimarr_2d(:, 1)) -call nc_put_real_1d(new_ncid, 'YC_2D', dimarr_2d(:, 2)) +new_ncid = nc_open_file_readwrite(new_name) +call nc_put_variable(new_ncid, 'PSAL', psal_f) +call nc_put_variable(new_ncid, 'PTMP', ptmp_f) +call nc_put_variable(new_ncid, 'UVEL', uvel_f) +call nc_put_variable(new_ncid, 'VVEL', vvel_f) +call nc_put_variable(new_ncid, 'ETA', eta_f) +call nc_put_variable(new_ncid, 'NO3', no3_f) +call nc_put_variable(new_ncid, 'PO4', po4_f) +call nc_put_variable(new_ncid, 'O2', o2_f) +call nc_put_variable(new_ncid, 'PHY', phy_f) +call nc_put_variable(new_ncid, 'ALK', alk_f) +call nc_put_variable(new_ncid, 'DIC', dic_f) +call nc_put_variable(new_ncid, 'DOP', dop_f) +call nc_put_variable(new_ncid, 'DON', don_f) +call nc_put_variable(new_ncid, 'FET', fet_f) +call nc_put_variable(new_ncid, 'CHL', chl_f) +call nc_put_variable(new_ncid, 'XC_3D', dimarr_3d(:, 1)) +call nc_put_variable(new_ncid, 'YC_3D', dimarr_3d(:, 2)) +call nc_put_variable(new_ncid, 'ZC_3D', dimarr_3d(:, 3)) +call nc_put_variable(new_ncid, 'XC_2D', dimarr_2d(:, 1)) +call nc_put_variable(new_ncid, 'YC_2D', dimarr_2d(:, 2)) call nc_close_file(new_ncid) -! Start writing the results: - +call finalize_utilities('dart_nc_reduce') end program nc_reduce From fbbb2013edec0fe3a392b61783ea0b0d0124cd87 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 18 Aug 2022 09:50:34 -0600 Subject: [PATCH 008/124] mirror of dart_nc_reduce. untested. mit_to_dart, dart_to_mit seems like place to put the offline squishing --- models/MITgcm_ocean/dart_nc_expand.f90 | 238 +++++++++++++++++++++++++ models/MITgcm_ocean/work/quickbuild.sh | 1 + 2 files changed, 239 insertions(+) create mode 100644 models/MITgcm_ocean/dart_nc_expand.f90 diff --git a/models/MITgcm_ocean/dart_nc_expand.f90 b/models/MITgcm_ocean/dart_nc_expand.f90 new file mode 100644 index 0000000000..db2b653595 --- /dev/null +++ b/models/MITgcm_ocean/dart_nc_expand.f90 @@ -0,0 +1,238 @@ +program nc_reduce + +use netcdf_utilities_mod, only : nc_get_variable, nc_define_dimension, nc_define_real_variable, & + nc_put_variable, nc_check, nc_open_file_readonly, & + nc_open_file_readwrite, nc_close_file, nc_create_file, & + nc_get_variable_size + +use types_mod, only : r4 + +use utilities_mod, only : initialize_utilities, finalize_utilities + +use netcdf + +implicit none + +integer :: ncid, ret, new_ncid, ncid_comp +character(len=NF90_MAX_NAME) :: new_name + + +integer, parameter :: ndim_3d = 3 +integer, parameter :: ndim_2d = 2 +integer, parameter :: hgrid = 500 +integer, parameter :: vgrid = 50 + +real(r4), allocatable :: psal(:,:,:), ptmp(:,:,:), uvel(:,:,:), vvel(:,:,:) +real(r4), allocatable :: no3(:,:,:), po4(:,:,:), o2(:,:,:), phy(:,:,:), alk(:,:,:) +real(r4), allocatable :: dic(:,:,:), dop(:,:,:), don(:,:,:), fet(:,:,:) +real(r4), allocatable :: eta(:,:), chl(:,:) +real(r4), allocatable :: psal_f(:), ptmp_f(:), uvel_f(:), vvel_f(:) +real(r4), allocatable :: no3_f(:), po4_f(:), o2_f(:), phy_f(:), alk_f(:) +real(r4), allocatable :: dic_f(:), dop_f(:), don_f(:), fet_f(:) +real(r4), allocatable :: eta_f(:), chl_f(:) + +! Dimensions +real(r4) :: xg(hgrid), xc(hgrid), yg(hgrid), yc(hgrid) +real(r4) :: zc(vgrid) +integer :: i,j,k ! loop counter +integer :: ct_3d, ct_2d, dimarr_3d_ct, dimarr_2d_ct +integer :: psalsize(ndim_3d), ptmpsize(ndim_3d), uvelsize(ndim_3d) +integer :: vvelsize(ndim_3d), no3size(ndim_3d), po4size(ndim_3d) +integer :: o2size(ndim_3d), physize(ndim_3d), alksize(ndim_3d) +integer :: dicsize(ndim_3d), dopsize(ndim_3d), donsize(ndim_3d), fetsize(ndim_3d) +integer :: etasize(ndim_2d), chlsize(ndim_2d) + + +call initialize_utilities('dart_nc_expand') + +ncid = nc_open_file_readonly('mem01.nc') + +call nc_get_variable(ncid, 'XC', xc) +call nc_get_variable(ncid, 'XG', xg) +call nc_get_variable(ncid, 'YC', yc) +call nc_get_variable(ncid, 'YG', yg) +call nc_get_variable(ncid, 'ZC', zc) + + +! Get the size, allocate arrays, and assign values. +call nc_get_variable_size(ncid, 'PSAL', psalsize) +call nc_get_variable_size(ncid, 'PTMP', ptmpsize) +call nc_get_variable_size(ncid, 'UVEL', uvelsize) +call nc_get_variable_size(ncid, 'VVEL', vvelsize) +call nc_get_variable_size(ncid, 'NO3', no3size) +call nc_get_variable_size(ncid, 'PO4', po4size) +call nc_get_variable_size(ncid, 'O2', o2size) +call nc_get_variable_size(ncid, 'PHY', physize) +call nc_get_variable_size(ncid, 'ALK', alksize) +call nc_get_variable_size(ncid, 'DIC', dicsize) +call nc_get_variable_size(ncid, 'DOP', dopsize) +call nc_get_variable_size(ncid, 'DON', donsize) +call nc_get_variable_size(ncid, 'FET', fetsize) +call nc_get_variable_size(ncid, 'ETA', etasize) +call nc_get_variable_size(ncid, 'CHL', chlsize) + +allocate(psal(psalsize(1), psalsize(2), psalsize(3))) +call nc_get_variable(ncid, 'PSAL', psal) + +allocate(ptmp(ptmpsize(1), ptmpsize(2), ptmpsize(3))) +call nc_get_variable(ncid, 'PTMP', ptmp) + +allocate(uvel(uvelsize(1), uvelsize(2), uvelsize(3))) +call nc_get_variable(ncid, 'UVEL', uvel) + +allocate(vvel(vvelsize(1), vvelsize(2), vvelsize(3))) +call nc_get_variable(ncid, 'VVEL', vvel) + +allocate(no3(no3size(1), no3size(2), no3size(3))) +call nc_get_variable(ncid, 'NO3', no3) + +allocate(po4(po4size(1), po4size(2), po4size(3))) +call nc_get_variable(ncid, 'PO4', po4) + +allocate(o2(o2size(1), o2size(2), o2size(3))) +call nc_get_variable(ncid, 'O2', o2) + +allocate(phy(physize(1), physize(2), physize(3))) +call nc_get_variable(ncid, 'PHY', phy) + +allocate(alk(alksize(1), alksize(2), alksize(3))) +call nc_get_variable(ncid, 'ALK', alk) + +allocate(dic(dicsize(1), dicsize(2), dicsize(3))) +call nc_get_variable(ncid, 'DIC', dic) + +allocate(dop(dopsize(1), dopsize(2), dopsize(3))) +call nc_get_variable(ncid, 'DOP', dop) + +allocate(don(donsize(1), donsize(2), donsize(3))) +call nc_get_variable(ncid, 'DON', don) + +allocate(fet(fetsize(1), fetsize(2), fetsize(3))) +call nc_get_variable(ncid, 'FET', fet) + +allocate(eta(etasize(1), etasize(2))) +call nc_get_variable(ncid, 'ETA', eta) + +allocate(chl(chlsize(1), chlsize(2))) +call nc_get_variable(ncid, 'CHL', chl) + +! counts are from the compressed file +ncid_comp = nc_open_file_readonly('output_mem01.nc') +call nc_get_variable_size(ncid_comp, 'psal_f', ct_3d) +call nc_get_variable_size(ncid_comp, 'chl_f', ct_2d) + + +allocate(psal_f(ct_3d)) +allocate(ptmp_f(ct_3d)) +allocate(uvel_f(ct_3d)) +allocate(vvel_f(ct_3d)) +allocate(no3_f(ct_3d)) +allocate(po4_f(ct_3d)) +allocate(o2_f(ct_3d)) +allocate(phy_f(ct_3d)) +allocate(alk_f(ct_3d)) +allocate(dic_f(ct_3d)) +allocate(dop_f(ct_3d)) +allocate(don_f(ct_3d)) +allocate(fet_f(ct_3d)) +allocate(chl_f(ct_2d)) +allocate(eta_f(ct_2d)) + + +dimarr_3d_ct = 1 +dimarr_2d_ct = 1 + +do k=1,psalsize(3) + do i=1,psalsize(1) + do j=1,psalsize(2) + if (psal(i,j,k) /= -999.) then + psal(i,j,k) = psal_f(dimarr_3d_ct) + ptmp(i,j,k) = ptmp_f(dimarr_3d_ct) + uvel(i,j,k) = uvel_f(dimarr_3d_ct) + vvel(i,j,k) = vvel_f(dimarr_3d_ct) + no3(i,j,k) = no3_f(dimarr_3d_ct) + po4(i,j,k) = po4_f(dimarr_3d_ct) + o2(i,j,k) = o2_f(dimarr_3d_ct) + phy(i,j,k) = phy_f(dimarr_3d_ct) + alk(i,j,k) = alk_f(dimarr_3d_ct) + dic(i,j,k) = dic_f(dimarr_3d_ct) + dop(i,j,k) = dop_f(dimarr_3d_ct) + don(i,j,k) = don_f(dimarr_3d_ct) + fet(i,j,k) = fet_f(dimarr_3d_ct) + dimarr_3d_ct = dimarr_3d_ct + 1 + endif + enddo + enddo +enddo + +do i=1,chlsize(1) + do j=1,chlsize(2) + if (chl(i,j) /= -999.) then + + eta(i,j) = eta_f(dimarr_2d_ct) + chl(i,j) = chl_f(dimarr_2d_ct) + + dimarr_2d_ct = dimarr_2d_ct + 1 + endif + enddo +enddo + + +! Start creating the new netcdf and define the new 1-d dimension. +new_name = 'unsquished_mem01.nc' +new_ncid = nc_create_file(new_name, 'unsquished file') +call nc_define_dimension(new_ncid, 'XG', hgrid) +call nc_define_dimension(new_ncid, 'XC', hgrid) +call nc_define_dimension(new_ncid, 'YG', hgrid) +call nc_define_dimension(new_ncid, 'YC', hgrid) +call nc_define_dimension(new_ncid, 'ZC', vgrid) + +! Put all the (new) variables in +call nc_define_real_variable(new_ncid, 'PSAL', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'PTMP', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'UVEL', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'VVEL', (/'XG','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'ETA', (/'XC','YC'/)) +call nc_define_real_variable(new_ncid, 'NO3', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'PO4', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'O2', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'PHY', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'ALK', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'DIC', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'DOP', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'DON', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'FET', (/'XC','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'CHL', (/'XC','YC'/)) + +! Close the file +call nc_close_file(new_ncid) + +! Write the information +new_ncid = nc_open_file_readwrite(new_name) +call nc_put_variable(new_ncid, 'PSAL', psal) +call nc_put_variable(new_ncid, 'PTMP', ptmp) +call nc_put_variable(new_ncid, 'UVEL', uvel) +call nc_put_variable(new_ncid, 'VVEL', vvel) +call nc_put_variable(new_ncid, 'ETA', eta) +call nc_put_variable(new_ncid, 'NO3', no3) +call nc_put_variable(new_ncid, 'PO4', po4) +call nc_put_variable(new_ncid, 'O2', o2) +call nc_put_variable(new_ncid, 'PHY', phy) +call nc_put_variable(new_ncid, 'ALK', alk) +call nc_put_variable(new_ncid, 'DIC', dic) +call nc_put_variable(new_ncid, 'DOP', dop) +call nc_put_variable(new_ncid, 'DON', don) +call nc_put_variable(new_ncid, 'FET', fet) +call nc_put_variable(new_ncid, 'CHL', chl) + +call nc_put_variable(new_ncid, 'XC', xc) +call nc_put_variable(new_ncid, 'XG', xg) +call nc_put_variable(new_ncid, 'YC', yc) +call nc_put_variable(new_ncid, 'YG', yg) +call nc_put_variable(new_ncid, 'ZC', zc) + +call nc_close_file(new_ncid) + +call finalize_utilities('dart_nc_reduce') + +end program nc_reduce diff --git a/models/MITgcm_ocean/work/quickbuild.sh b/models/MITgcm_ocean/work/quickbuild.sh index 1a83d71483..7d48b2f058 100755 --- a/models/MITgcm_ocean/work/quickbuild.sh +++ b/models/MITgcm_ocean/work/quickbuild.sh @@ -35,6 +35,7 @@ dart_to_mit mit_to_dart create_ocean_obs dart_nc_reduce +dart_nc_expand ) arguments "$@" From b14007ddd8db4502e9d814bdcfd494d93c13a27a Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 19 Aug 2022 15:52:30 -0600 Subject: [PATCH 009/124] ZC is double - check dart_nc_reduce --- models/MITgcm_ocean/dart_nc_expand.f90 | 40 ++++++++++++++++++++------ 1 file changed, 31 insertions(+), 9 deletions(-) diff --git a/models/MITgcm_ocean/dart_nc_expand.f90 b/models/MITgcm_ocean/dart_nc_expand.f90 index db2b653595..5f5301aae8 100644 --- a/models/MITgcm_ocean/dart_nc_expand.f90 +++ b/models/MITgcm_ocean/dart_nc_expand.f90 @@ -3,9 +3,9 @@ program nc_reduce use netcdf_utilities_mod, only : nc_get_variable, nc_define_dimension, nc_define_real_variable, & nc_put_variable, nc_check, nc_open_file_readonly, & nc_open_file_readwrite, nc_close_file, nc_create_file, & - nc_get_variable_size + nc_get_variable_size, nc_define_double_variable -use types_mod, only : r4 +use types_mod, only : r4, r8 use utilities_mod, only : initialize_utilities, finalize_utilities @@ -13,7 +13,7 @@ program nc_reduce implicit none -integer :: ncid, ret, new_ncid, ncid_comp +integer :: ncid, new_ncid, ncid_comp character(len=NF90_MAX_NAME) :: new_name @@ -33,7 +33,7 @@ program nc_reduce ! Dimensions real(r4) :: xg(hgrid), xc(hgrid), yg(hgrid), yc(hgrid) -real(r4) :: zc(vgrid) +real(r8) :: zc(vgrid) ! ZC is double integer :: i,j,k ! loop counter integer :: ct_3d, ct_2d, dimarr_3d_ct, dimarr_2d_ct integer :: psalsize(ndim_3d), ptmpsize(ndim_3d), uvelsize(ndim_3d) @@ -118,9 +118,8 @@ program nc_reduce ! counts are from the compressed file ncid_comp = nc_open_file_readonly('output_mem01.nc') -call nc_get_variable_size(ncid_comp, 'psal_f', ct_3d) -call nc_get_variable_size(ncid_comp, 'chl_f', ct_2d) - +call nc_get_variable_size(ncid_comp, 'PSAL', ct_3d) +call nc_get_variable_size(ncid_comp, 'CHL', ct_2d) allocate(psal_f(ct_3d)) allocate(ptmp_f(ct_3d)) @@ -138,6 +137,22 @@ program nc_reduce allocate(chl_f(ct_2d)) allocate(eta_f(ct_2d)) +call nc_get_variable(ncid_comp, 'PSAL', psal_f) +call nc_get_variable(ncid_comp, 'PTMP', ptmp_f) +call nc_get_variable(ncid_comp, 'UVEL', uvel_f) +call nc_get_variable(ncid_comp, 'VVEL', vvel_f) +call nc_get_variable(ncid_comp, 'NO3', no3_f) +call nc_get_variable(ncid_comp, 'PO4', po4_f) +call nc_get_variable(ncid_comp, 'O2', o2_f) +call nc_get_variable(ncid_comp, 'PHY', phy_f) +call nc_get_variable(ncid_comp, 'ALK', alk_f) +call nc_get_variable(ncid_comp, 'DIC', dic_f) +call nc_get_variable(ncid_comp, 'DOP', dop_f) +call nc_get_variable(ncid_comp, 'DON', don_f) +call nc_get_variable(ncid_comp, 'FET', fet_f) +call nc_get_variable(ncid_comp, 'ETA', eta_f) +call nc_get_variable(ncid_comp, 'CHL', chl_f) + dimarr_3d_ct = 1 dimarr_2d_ct = 1 @@ -190,8 +205,8 @@ program nc_reduce ! Put all the (new) variables in call nc_define_real_variable(new_ncid, 'PSAL', (/'XC','YC','ZC'/)) call nc_define_real_variable(new_ncid, 'PTMP', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'UVEL', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'VVEL', (/'XG','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'UVEL', (/'XG','YC','ZC'/)) +call nc_define_real_variable(new_ncid, 'VVEL', (/'XC','YG','ZC'/)) call nc_define_real_variable(new_ncid, 'ETA', (/'XC','YC'/)) call nc_define_real_variable(new_ncid, 'NO3', (/'XC','YC','ZC'/)) call nc_define_real_variable(new_ncid, 'PO4', (/'XC','YC','ZC'/)) @@ -204,6 +219,13 @@ program nc_reduce call nc_define_real_variable(new_ncid, 'FET', (/'XC','YC','ZC'/)) call nc_define_real_variable(new_ncid, 'CHL', (/'XC','YC'/)) + +call nc_define_real_variable(new_ncid, 'XC','XC') +call nc_define_real_variable(new_ncid, 'XG','XG') +call nc_define_real_variable(new_ncid, 'YC','YC') +call nc_define_real_variable(new_ncid, 'YG','YG') +call nc_define_double_variable(new_ncid, 'ZC','ZC') + ! Close the file call nc_close_file(new_ncid) From d9e2979cf8c6d8a1c10a39005e3ef53e5388d709 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 22 Aug 2022 11:13:25 -0600 Subject: [PATCH 010/124] zc double dart_nc_expand --- models/MITgcm_ocean/dart_nc_reduce.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/models/MITgcm_ocean/dart_nc_reduce.f90 b/models/MITgcm_ocean/dart_nc_reduce.f90 index 29570d8544..06bff0faa3 100644 --- a/models/MITgcm_ocean/dart_nc_reduce.f90 +++ b/models/MITgcm_ocean/dart_nc_reduce.f90 @@ -3,9 +3,9 @@ program nc_reduce use netcdf_utilities_mod, only : nc_get_variable, nc_define_dimension, nc_define_real_variable, & nc_put_variable, nc_check, nc_open_file_readonly, & nc_open_file_readwrite, nc_close_file, nc_create_file, & - nc_get_variable_size + nc_get_variable_size, nc_define_double_variable -use types_mod, only : r4 +use types_mod, only : r4, r8 use utilities_mod, only : initialize_utilities, finalize_utilities @@ -31,7 +31,7 @@ program nc_reduce ! Dimensions !real(r4) :: xg(2000), xc(2000), yg(2000), yc(2000) real(r4) :: xg(500), xc(500), yg(500), yc(500) -real(r4) :: zc(50) +real(r8) :: zc(50) integer :: i,j,k ! loop counter integer :: ct_3d, ct_2d, dimarr_3d_ct, dimarr_2d_ct integer :: psalsize(ndim_3d), ptmpsize(ndim_3d), uvelsize(ndim_3d) @@ -253,7 +253,7 @@ program nc_reduce call nc_define_real_variable(new_ncid, 'XC_2D', 'useful_info_2d') call nc_define_real_variable(new_ncid, 'YC_3D', 'useful_info_3d') call nc_define_real_variable(new_ncid, 'YC_2D', 'useful_info_2d') -call nc_define_real_variable(new_ncid, 'ZC_3D', 'useful_info_3d') +call nc_define_double_variable(new_ncid, 'ZC_3D', 'useful_info_3d') ! Close the file call nc_close_file(new_ncid) From d197e63163e572fbdc9729d2ae6a14537f1bbd35 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 22 Aug 2022 14:58:11 -0600 Subject: [PATCH 011/124] netcdf and model_mod_check for comparision with main --- assimilation_code/modules/utilities/netcdf_utilities_mod.f90 | 2 +- assimilation_code/programs/model_mod_check/model_mod_check.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 b/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 index 74301bd6f4..22c819a37b 100644 --- a/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 +++ b/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 @@ -2415,7 +2415,7 @@ function nc_create_file(filename, context) character(len=*), parameter :: routine = 'nc_create_file' integer :: ret, ncid, oldmode -ret = nf90_create(filename, NF90_CLOBBER, ncid) +ret = nf90_create(filename, ior(NF90_CLOBBER,NF90_64BIT_OFFSET), ncid) call nc_check(ret, routine, 'create '//trim(filename)//' read/write', context) call add_fh_to_list(ncid, filename) diff --git a/assimilation_code/programs/model_mod_check/model_mod_check.f90 b/assimilation_code/programs/model_mod_check/model_mod_check.f90 index c35ff0a07e..f56c7617a1 100644 --- a/assimilation_code/programs/model_mod_check/model_mod_check.f90 +++ b/assimilation_code/programs/model_mod_check/model_mod_check.f90 @@ -416,7 +416,7 @@ subroutine check_meta_data( iloc ) kind_index=qty_index, & kind_string=qty_string) -write(string1,'("index ",i11," is i,j,k",3(1x,i4)," and is in domain ",i2)') & +write(string1,'("index ",i11," is i,j,k",3(1x,i10)," and is in domain ",i2)') & iloc, ix, iy, iz, dom_id write(string2,'("is quantity ", I4,", ",A)') var_type, trim(qty_string)//' at location' call write_location(0,loc,charstring=string3) From a409ff4c4d697fcd850129708420f7340f043a64 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 25 Aug 2022 08:40:00 -0600 Subject: [PATCH 012/124] function for defining variables mit2dart FVAL a parameter --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 315 ++++++++++++---------- 1 file changed, 175 insertions(+), 140 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 15861b8164..1debec30f9 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -20,9 +20,13 @@ module trans_mitdart_mod integer :: io, iunit logical :: do_bgc = .false. -logical :: log_transform = .false. +logical :: log_transform = .false. +logical :: compress = .false. +! set compress = .true. remove missing values from state -namelist /trans_mitdart_nml/ do_bgc, log_transform +namelist /trans_mitdart_nml/ do_bgc, log_transform, compress + +real(r4), parameter :: FVAL=-999.0_r4 ! may put this as a namelist option !------------------------------------------------------------------ ! @@ -75,6 +79,22 @@ module trans_mitdart_mod ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) + +! 3D variables, 3 grids: +! +! XC, YC, ZC 1 PSAL, PTMP, NO3, PO4, O2, PHY, ALK, DIC, DOP, DON, FET +! XC, YC, ZG 2 UVEL +! XC, YG, ZC 3 VVEL +! XC, YG, ZG 4 +! XG, YG, ZC 5 +! XG, YC, ZG 6 +! XG, YG, ZC 7 +! XG, YG, ZG 8 + +! 2D variables, 1 grid: +! +! YC, XC ETA, CHL + private public :: static_init_trans, mit2dart, dart2mit @@ -215,6 +235,9 @@ subroutine mit2dart() ! for the dimensions and coordinate variables integer :: XGDimID, XCDimID, YGDimID, YCDimID, ZGDimID, ZCDimID integer :: XGVarID, XCVarID, YGVarID, YCVarID, ZGVarID, ZCVarID +integer :: comp2ID, comp3ID ! compressed dim +integer :: all_dimids(7) ! store the 8 dimension ids + ! for the prognostic variables integer :: SVarID, TVarID, UVarID, VVarID, EtaVarID @@ -226,11 +249,11 @@ subroutine mit2dart() real(r4), allocatable :: data_3d(:,:,:), data_2d(:,:) -real(r4) :: FVAL + if (.not. module_initialized) call static_init_trans -FVAL=-999.0_r4 + allocate(data_3d(Nx,Ny,Nz)) allocate(data_2d(Nx,Ny)) @@ -238,13 +261,19 @@ subroutine mit2dart() call check(nf90_create(path="OUTPUT.nc",cmode=or(nf90_clobber,nf90_64bit_offset),ncid=ncid)) ! Define the new dimensions IDs - -call check(nf90_def_dim(ncid=ncid, name="XG", len = Nx, dimid = XGDimID)) + call check(nf90_def_dim(ncid=ncid, name="XC", len = Nx, dimid = XCDimID)) -call check(nf90_def_dim(ncid=ncid, name="YG", len = Ny, dimid = YGDimID)) call check(nf90_def_dim(ncid=ncid, name="YC", len = Ny, dimid = YCDimID)) call check(nf90_def_dim(ncid=ncid, name="ZC", len = Nz, dimid = ZCDimID)) - + +call check(nf90_def_dim(ncid=ncid, name="XG", len = Nx, dimid = XGDimID)) +call check(nf90_def_dim(ncid=ncid, name="YG", len = Ny, dimid = YGDimID)) + +call check(nf90_def_dim(ncid=ncid, name="comp2d", len = Nz, dimid = comp2ID)) +call check(nf90_def_dim(ncid=ncid, name="comp3d", len = Nz, dimid = comp3ID)) + +all_dimids = (/XCDimID, YCDimID, ZCDimID, XGDimID, YGDimID, comp2ID, comp3ID/) + ! Create the (empty) Coordinate Variables and the Attributes ! U Grid Longitudes @@ -290,142 +319,68 @@ subroutine mit2dart() call check(nf90_put_att(ncid, ZCVarID, "axis", "Z")) call check(nf90_put_att(ncid, ZCVarID, "standard_name", "depth")) +! The size of these variables will depend on the compression ! Create the (empty) Prognostic Variables and the Attributes -call check(nf90_def_var(ncid=ncid, name="PSAL", xtype=nf90_real, & - dimids = (/XCDimID,YCDimID,ZCDimID/),varid=SVarID)) -call check(nf90_put_att(ncid, SVarID, "long_name", "potential salinity")) -call check(nf90_put_att(ncid, SVarID, "missing_value", FVAL)) -call check(nf90_put_att(ncid, SVarID, "_FillValue", FVAL)) -call check(nf90_put_att(ncid, SVarID, "units", "psu")) -call check(nf90_put_att(ncid, SVarID, "units_long_name", "practical salinity units")) - -call check(nf90_def_var(ncid=ncid, name="PTMP", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=TVarID)) -call check(nf90_put_att(ncid, TVarID, "long_name", "Potential Temperature")) -call check(nf90_put_att(ncid, TVarID, "missing_value", FVAL)) -call check(nf90_put_att(ncid, TVarID, "_FillValue", FVAL)) -call check(nf90_put_att(ncid, TVarID, "units", "C")) -call check(nf90_put_att(ncid, TVarID, "units_long_name", "degrees celsius")) - -call check(nf90_def_var(ncid=ncid, name="UVEL", xtype=nf90_real, & - dimids=(/XGDimID,YCDimID,ZCDimID/),varid=UVarID)) -call check(nf90_put_att(ncid, UVarID, "long_name", "Zonal Velocity")) -call check(nf90_put_att(ncid, UVarID, "mssing_value", FVAL)) -call check(nf90_put_att(ncid, UVarID, "_FillValue", FVAL)) -call check(nf90_put_att(ncid, UVarID, "units", "m/s")) -call check(nf90_put_att(ncid, UVarID, "units_long_name", "meters per second")) - -call check(nf90_def_var(ncid=ncid, name="VVEL", xtype=nf90_real, & - dimids=(/XCDimID,YGDimID,ZCDimID/),varid=VVarID)) -call check(nf90_put_att(ncid, VVarID, "long_name", "Meridional Velocity")) -call check(nf90_put_att(ncid, VVarID, "missing_value", FVAL)) -call check(nf90_put_att(ncid, VVarID, "_FillValue", FVAL)) -call check(nf90_put_att(ncid, VVarID, "units", "m/s")) -call check(nf90_put_att(ncid, VVarID, "units_long_name", "meters per second")) - -call check(nf90_def_var(ncid=ncid, name="ETA", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID/),varid=EtaVarID)) -call check(nf90_put_att(ncid, EtaVarID, "long_name", "sea surface height")) -call check(nf90_put_att(ncid, EtaVarID, "missing_value", FVAL)) -call check(nf90_put_att(ncid, EtaVarID, "_FillValue", FVAL)) -call check(nf90_put_att(ncid, EtaVarID, "units", "m")) -call check(nf90_put_att(ncid, EtaVarID, "units_long_name", "meters")) +SVarID = define_variable(ncid,"PSAL", nf90_real, all_dimids) +call add_attributes_to_variable(ncid, SVarID, "potential salinity", "psu", "practical salinity units") + +TVarID = define_variable(ncid,"PTMP", nf90_real, all_dimids) +call add_attributes_to_variable(ncid, TVarID, "Potential Temperature", "C", "degrees celsius") + +UVarID = define_variable(ncid,"UVEL", nf90_real, all_dimids) +call add_attributes_to_variable(ncid, UVarID, "Zonal Velocity", "m/s", "meters per second") + +VVarID = define_variable(ncid,"VVEL", nf90_real, all_dimids) +call add_attributes_to_variable(ncid, VVarID, "Meridional Velocity", "m/s", "meters per second") + +EtaVarID = define_variable_2d(ncid,"ETA", nf90_real, all_dimids) +call add_attributes_to_variable(ncid, EtaVarID, "sea surface height", "m", "meters") !> Add BLING data: if (do_bgc) then ! 1. BLING tracer: nitrate NO3 - call check(nf90_def_var(ncid=ncid, name="NO3", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=no3_varid)) - call check(nf90_put_att(ncid, no3_varid, "long_name" , "Nitrate")) - call check(nf90_put_att(ncid, no3_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, no3_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, no3_varid, "units" , "mol N/m3")) - call check(nf90_put_att(ncid, no3_varid, "units_long_name", "moles Nitrogen per cubic meters")) - + no3_varid = define_variable(ncid,"NO3", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, no3_varid, "Nitrate", "mol N/m3", "moles Nitrogen per cubic meters") + ! 2. BLING tracer: phosphate PO4 - call check(nf90_def_var(ncid=ncid, name="PO4", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=po4_varid)) - call check(nf90_put_att(ncid, po4_varid, "long_name" , "Phosphate")) - call check(nf90_put_att(ncid, po4_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, po4_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, po4_varid, "units" , "mol P/m3")) - call check(nf90_put_att(ncid, po4_varid, "units_long_name", "moles Phosphorus per cubic meters")) - + po4_varid = define_variable(ncid,"PO4", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, po4_varid, "Phosphate", "mol P/m3", "moles Phosphorus per cubic meters") + ! 3. BLING tracer: oxygen O2 - call check(nf90_def_var(ncid=ncid, name="O2", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=o2_varid)) - call check(nf90_put_att(ncid, o2_varid, "long_name" , "Dissolved Oxygen")) - call check(nf90_put_att(ncid, o2_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, o2_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, o2_varid, "units" , "mol O/m3")) - call check(nf90_put_att(ncid, o2_varid, "units_long_name", "moles Oxygen per cubic meters")) - + o2_varid = define_variable(ncid,"O2", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, o2_varid, "Dissolved Oxygen", "mol O/m3", "moles Oxygen per cubic meters") + ! 4. BLING tracer: phytoplankton PHY - call check(nf90_def_var(ncid=ncid, name="PHY", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=phy_varid)) - call check(nf90_put_att(ncid, phy_varid, "long_name" , "Phytoplankton Biomass")) - call check(nf90_put_att(ncid, phy_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, phy_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, phy_varid, "units" , "mol C/m3")) - call check(nf90_put_att(ncid, phy_varid, "units_long_name", "moles Carbon per cubic meters")) + phy_varid = define_variable(ncid,"PHY", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, phy_varid, "Phytoplankton Biomass", "mol C/m3", "moles Carbon per cubic meters") ! 5. BLING tracer: alkalinity ALK - call check(nf90_def_var(ncid=ncid, name="ALK", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=alk_varid)) - call check(nf90_put_att(ncid, alk_varid, "long_name" , "Alkalinity")) - call check(nf90_put_att(ncid, alk_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, alk_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, alk_varid, "units" , "mol eq/m3")) - call check(nf90_put_att(ncid, alk_varid, "units_long_name", "moles equivalent per cubic meters")) - + alk_varid = define_variable(ncid,"ALK", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, alk_varid, "Alkalinity", "mol eq/m3", "moles equivalent per cubic meters") + ! 6. BLING tracer: dissolved inorganic carbon DIC - call check(nf90_def_var(ncid=ncid, name="DIC", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=dic_varid)) - call check(nf90_put_att(ncid, dic_varid, "long_name" , "Dissolved Inorganic Carbon")) - call check(nf90_put_att(ncid, dic_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, dic_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, dic_varid, "units" , "mol C/m3")) - call check(nf90_put_att(ncid, dic_varid, "units_long_name", "moles Carbon per cubic meters")) - - ! 7. BLING tracer: dissolved organic phosphorus DOP - call check(nf90_def_var(ncid=ncid, name="DOP", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=dop_varid)) - call check(nf90_put_att(ncid, dop_varid, "long_name" , "Dissolved Organic Phosphorus")) - call check(nf90_put_att(ncid, dop_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, dop_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, dop_varid, "units" , "mol P/m3")) - call check(nf90_put_att(ncid, dop_varid, "units_long_name", "moles Phosphorus per cubic meters")) + dic_varid = define_variable(ncid,"DIC", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, dic_varid, "Dissolved Inorganic Carbon", "mol C/m3", "moles Carbon per cubic meters") + + ! 7. BLING tracer: dissolved organic phosphorus DOP + dop_varid = define_variable(ncid,"DOP", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, dop_varid, "Dissolved Organic Phosphorus", "mol P/m3", "moles Phosphorus per cubic meters") ! 8. BLING tracer: dissolved organic nitrogen DON - call check(nf90_def_var(ncid=ncid, name="DON", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=don_varid)) - call check(nf90_put_att(ncid, don_varid, "long_name" , "Dissolved Organic Nitrogen")) - call check(nf90_put_att(ncid, don_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, don_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, don_varid, "units" , "mol N/m3")) - call check(nf90_put_att(ncid, don_varid, "units_long_name", "moles Nitrogen per cubic meters")) + don_varid = define_variable(ncid,"DON", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, don_varid, "Dissolved Organic Nitrogen", "mol N/m3", "moles Nitrogen per cubic meters") ! 9. BLING tracer: dissolved inorganic iron FET - call check(nf90_def_var(ncid=ncid, name="FET", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID,ZCDimID/),varid=fet_varid)) - call check(nf90_put_att(ncid, fet_varid, "long_name" , "Dissolved Inorganic Iron")) - call check(nf90_put_att(ncid, fet_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, fet_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, fet_varid, "units" , "mol Fe/m3")) - call check(nf90_put_att(ncid, fet_varid, "units_long_name", "moles Iron per cubic meters")) - + fet_varid = define_variable(ncid,"FET", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, fet_varid, "Dissolved Inorganic Iron", "mol Fe/m3", "moles Iron per cubic meters") + ! 10. BLING tracer: Surface Chlorophyl CHL - call check(nf90_def_var(ncid=ncid, name="CHL", xtype=nf90_real, & - dimids=(/XCDimID,YCDimID/),varid=chl_varid)) - call check(nf90_put_att(ncid, chl_varid, "long_name" , "Surface Chlorophyll")) - call check(nf90_put_att(ncid, chl_varid, "missing_value" , FVAL)) - call check(nf90_put_att(ncid, chl_varid, "_FillValue" , FVAL)) - call check(nf90_put_att(ncid, chl_varid, "units" , "mg/m3")) - call check(nf90_put_att(ncid, chl_varid, "units_long_name", "milligram per cubic meters")) -endif + chl_varid = define_variable(ncid,"CHL", nf90_real, all_dimids) + call add_attributes_to_variable(ncid, chl_varid, "Surface Chlorophyll", "mg/m3", "milligram per cubic meters" ) +endif ! Finished with dimension/variable definitions, must end 'define' mode to fill. @@ -447,35 +402,35 @@ subroutine mit2dart() read(iunit,rec=1)data_3d close(iunit) where (data_3d == 0.0_r4) data_3d = FVAL -call check(nf90_put_var(ncid,SVarID,data_3d,start=(/1,1,1/))) +call check(nf90_put_var(ncid,SVarID,data_3d)) open(iunit, file='PTMP.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) where (data_3d == 0.0_r4) data_3d = FVAL -call check(nf90_put_var(ncid,TVarID,data_3d,start=(/1,1,1/))) +call check(nf90_put_var(ncid,TVarID,data_3d)) open(iunit, file='UVEL.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) where (data_3d == 0.0_r4) data_3d = FVAL -call check(nf90_put_var(ncid,UVarID,data_3d,start=(/1,1,1/))) +call check(nf90_put_var(ncid,UVarID,data_3d)) open(iunit, file='VVEL.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) where (data_3d == 0.0_r4) data_3d = FVAL -call check(nf90_put_var(ncid,VVarID,data_3d,start=(/1,1,1/))) +call check(nf90_put_var(ncid,VVarID,data_3d)) open(iunit, file='ETA.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') read(iunit,rec=1)data_2d close(iunit) where (data_2d == 0.0_r4) data_2d = FVAL -call check(nf90_put_var(ncid,EtaVarID,data_2d,start=(/1,1/))) +call check(nf90_put_var(ncid,EtaVarID,data_2d)) if (do_bgc) then open(iunit, file='NO3.data', form='UNFORMATTED', status='OLD', & @@ -483,63 +438,63 @@ subroutine mit2dart() read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,no3_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,no3_varid,data_3d)) open(iunit, file='PO4.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,po4_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,po4_varid,data_3d)) open(iunit, file='O2.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,o2_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,o2_varid,data_3d)) open(iunit, file='PHY.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,phy_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,phy_varid,data_3d)) open(iunit, file='ALK.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,alk_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,alk_varid,data_3d)) open(iunit, file='DIC.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,dic_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,dic_varid,data_3d)) open(iunit, file='DOP.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,dop_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,dop_varid,data_3d)) open(iunit, file='DON.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,don_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,don_varid,data_3d)) open(iunit, file='FET.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1)data_3d close(iunit) call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,fet_varid,data_3d,start=(/1,1,1/))) + call check(nf90_put_var(ncid,fet_varid,data_3d)) open(iunit, file='CHL.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') @@ -550,7 +505,7 @@ subroutine mit2dart() elsewhere data_2d = log10(data_2d) endwhere - call check(nf90_put_var(ncid,chl_varid,data_2d,start=(/1,1/))) + call check(nf90_put_var(ncid,chl_varid,data_2d)) endif call check(nf90_close(ncid)) @@ -742,6 +697,86 @@ subroutine check(status) end subroutine check +!=============================================================================== +! 3D variable +function define_variable(ncid, name, nc_type, all_dimids) result(varid) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: name ! variable name +integer, intent(in) :: nc_type +integer, intent(in) :: all_dimids(7) ! possible dimension ids +integer :: varid ! netcdf variable id + +integer :: dimids(3) + +if (compress) then + call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & + dimids=all_dimids(6),varid=varid)) +else + + dimids = which_dims(name, all_dimids) + call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & + dimids=dimids, varid=varid)) +endif + +end function define_variable + +!------------------------------------------------------------------ +! For the non-compressed variables, X,Y,Z dimesnions vary +! depending on the variable +function which_dims(name, all_dimids) result(dimids) + +character(len=*), intent(in) :: name ! variable name +integer, intent(in) :: all_dimids(7) +integer :: dimids(3) +! 3D variables, 3 grids: +! XC, YC, ZC 1 PSAL, PTMP, NO3, PO4, O2, PHY, ALK, DIC, DOP, DON, FET +! XG, YC, ZC 2 UVEL +! XC, YG, ZC 3 VVEL + +if (name=='UVEL') dimids = (/all_dimids(4),all_dimids(2),all_dimids(3)/); return +if (name=='VVEL') dimids = (/all_dimids(1),all_dimids(5),all_dimids(3)/); return + +dimids = (/all_dimids(1),all_dimids(2),all_dimids(3)/) + +end function + +!------------------------------------------------------------------ +! 2D variable +function define_variable_2d(ncid, name, nc_type, all_dimids) result(varid) + +integer, intent(in) :: ncid +character(len=*), intent(in) :: name ! variable name +integer, intent(in) :: nc_type +integer, intent(in) :: all_dimids(7) +integer :: varid ! netcdf variable id + +! 2D variables, 1 grid: +! YC, XC 1 ETA, CHL + +if (compress) then + call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & + dimids = (/all_dimids(7)/),varid=varid)) +else + call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & + dimids = (/all_dimids(1),all_dimids(2)/),varid=varid)) +endif + +end function define_variable_2d + +!------------------------------------------------------------------ +subroutine add_attributes_to_variable(ncid, varid, long_name, units, units_long_name) + +integer, intent(in) :: ncid, varid ! which file, which variable +character(len=*), intent(in) :: long_name, units, units_long_name + +call check(nf90_put_att(ncid, varid, "long_name" , long_name)) +call check(nf90_put_att(ncid, varid, "missing_value" , FVAL)) +call check(nf90_put_att(ncid, varid, "_FillValue" , FVAL)) +call check(nf90_put_att(ncid, varid, "units" , units)) +call check(nf90_put_att(ncid, varid, "units_long_name", units_long_name)) + +end subroutine !=============================================================================== !> Check the tracer variables after reading from the binaries From 3d0c053361f2a25f98c2b6dde9f5a4e61af12221 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 25 Aug 2022 13:58:51 -0600 Subject: [PATCH 013/124] function for dart to mit. untested. --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 469 +++++++--------------- 1 file changed, 151 insertions(+), 318 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 1debec30f9..77289f73a6 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -43,11 +43,7 @@ module trans_mitdart_mod integer, parameter :: max_nz = 512 integer, parameter :: max_nr = 512 -!-- record lengths for reading/writing binary files -integer :: recl3d -integer :: recl2d - -!-- Gridding parameters variable declarations +!-- Gridding parameters variable declarations logical :: usingCartesianGrid, usingCylindricalGrid, & usingSphericalPolarGrid, usingCurvilinearGrid, & deepAtmosphere @@ -85,11 +81,6 @@ module trans_mitdart_mod ! XC, YC, ZC 1 PSAL, PTMP, NO3, PO4, O2, PHY, ALK, DIC, DOP, DON, FET ! XC, YC, ZG 2 UVEL ! XC, YG, ZC 3 VVEL -! XC, YG, ZG 4 -! XG, YG, ZC 5 -! XG, YC, ZG 6 -! XG, YG, ZC 7 -! XG, YG, ZG 8 ! 2D variables, 1 grid: ! @@ -120,7 +111,6 @@ subroutine static_init_trans() read(iunit, nml = trans_mitdart_nml, iostat = io) call check_namelist_read(iunit, io, 'trans_mitdart_nml') - ! Grid-related variables are in PARM04 delX(:) = 0.0_r4 delY(:) = 0.0_r4 @@ -212,17 +202,6 @@ subroutine static_init_trans() ZC(i) = ZC(i-1) - 0.5_r8 * delZ(i-1) - 0.5_r8 * delZ(i) enddo -! set record lengths -recl3d = Nx*Ny*Nz*4 -recl2d = Nx*Ny*4 - -! MEG Better have that as inout namelist parameter -! Are we also doing bgc on top of physics? -! If we found nitrate then the rest of the binaries (for the -! remaining 9 variables) should be also there. -! TODO may also enhance this functionality -! if (file_exist('NO3.data')) do_bgc = .true. - end subroutine static_init_trans !------------------------------------------------------------------ @@ -230,7 +209,8 @@ end subroutine static_init_trans subroutine mit2dart() -integer :: ncid, iunit +integer :: ncid +integer :: dsize3, dsize2 ! size of 3d,2d variable ! for the dimensions and coordinate variables integer :: XGDimID, XCDimID, YGDimID, YCDimID, ZGDimID, ZCDimID @@ -247,17 +227,8 @@ subroutine mit2dart() ! diagnostic variable integer :: chl_varid -real(r4), allocatable :: data_3d(:,:,:), data_2d(:,:) - - - if (.not. module_initialized) call static_init_trans - - -allocate(data_3d(Nx,Ny,Nz)) -allocate(data_2d(Nx,Ny)) - call check(nf90_create(path="OUTPUT.nc",cmode=or(nf90_clobber,nf90_64bit_offset),ncid=ncid)) ! Define the new dimensions IDs @@ -338,7 +309,7 @@ subroutine mit2dart() EtaVarID = define_variable_2d(ncid,"ETA", nf90_real, all_dimids) call add_attributes_to_variable(ncid, EtaVarID, "sea surface height", "m", "meters") -!> Add BLING data: +! Create the BLING netcdf variables: if (do_bgc) then ! 1. BLING tracer: nitrate NO3 @@ -395,124 +366,30 @@ subroutine mit2dart() call check(nf90_put_var(ncid, ZCVarID, ZC )) ! Fill the data - -iunit = get_unit() -open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') -read(iunit,rec=1)data_3d -close(iunit) -where (data_3d == 0.0_r4) data_3d = FVAL -call check(nf90_put_var(ncid,SVarID,data_3d)) - -open(iunit, file='PTMP.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') -read(iunit,rec=1)data_3d -close(iunit) -where (data_3d == 0.0_r4) data_3d = FVAL -call check(nf90_put_var(ncid,TVarID,data_3d)) - -open(iunit, file='UVEL.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') -read(iunit,rec=1)data_3d -close(iunit) -where (data_3d == 0.0_r4) data_3d = FVAL -call check(nf90_put_var(ncid,UVarID,data_3d)) - -open(iunit, file='VVEL.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') -read(iunit,rec=1)data_3d -close(iunit) -where (data_3d == 0.0_r4) data_3d = FVAL -call check(nf90_put_var(ncid,VVarID,data_3d)) - -open(iunit, file='ETA.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') -read(iunit,rec=1)data_2d -close(iunit) -where (data_2d == 0.0_r4) data_2d = FVAL -call check(nf90_put_var(ncid,EtaVarID,data_2d)) - -if (do_bgc) then - open(iunit, file='NO3.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,no3_varid,data_3d)) - - open(iunit, file='PO4.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,po4_varid,data_3d)) - - open(iunit, file='O2.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,o2_varid,data_3d)) - - open(iunit, file='PHY.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,phy_varid,data_3d)) - - open(iunit, file='ALK.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,alk_varid,data_3d)) - - open(iunit, file='DIC.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,dic_varid,data_3d)) - - open(iunit, file='DOP.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,dop_varid,data_3d)) - - open(iunit, file='DON.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,don_varid,data_3d)) - - open(iunit, file='FET.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_3d - close(iunit) - call fill_var_md(data_3d, FVAL) - call check(nf90_put_var(ncid,fet_varid,data_3d)) - - open(iunit, file='CHL.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') - read(iunit,rec=1)data_2d - close(iunit) - where (data_2d == 0.0_r4) - data_2d = FVAL - elsewhere - data_2d = log10(data_2d) - endwhere - call check(nf90_put_var(ncid,chl_varid,data_2d)) +dsize3 = Nx*Ny*Nz +dsize2 = Nx*Ny + +! Fill the netcdf variables +call from_mit_to_netcdf('PSAL.data', ncid, SVarID, dsize3) +call from_mit_to_netcdf('PTMP.data', ncid, TVarID, dsize3) +call from_mit_to_netcdf('UVEL.data', ncid, UVarID, dsize3) +call from_mit_to_netcdf('VVEL.data', ncid, VVarID, dsize3) +call from_mit_to_netcdf('ETA.data', ncid, EtaVarID, dsize2) + +if (do_bgc) then + call from_mit_to_netcdf_tracer('NO3.data', ncid, no3_varid, dsize3) + call from_mit_to_netcdf_tracer('PO4.data', ncid, po4_varid, dsize3) + call from_mit_to_netcdf_tracer('O2.data', ncid, o2_varid, dsize3) + call from_mit_to_netcdf_tracer('PHY.data', ncid, phy_varid, dsize3) + call from_mit_to_netcdf_tracer('ALK.data', ncid, alk_varid, dsize3) + call from_mit_to_netcdf_tracer('DIC.data', ncid, dic_varid, dsize3) + call from_mit_to_netcdf_tracer('DON.data', ncid, don_varid, dsize3) + call from_mit_to_netcdf_tracer('FET.data', ncid, fet_varid, dsize3) + call from_mit_to_netcdf_tracer('FET.data', ncid, fet_varid, dsize2) endif call check(nf90_close(ncid)) -deallocate(data_3d) -deallocate(data_2d) - end subroutine mit2dart !------------------------------------------------------------------ @@ -520,166 +397,39 @@ end subroutine mit2dart subroutine dart2mit() -integer :: ncid, varid, iunit -real(r4), allocatable :: data_3d(:,:,:),data_2d(:,:) -real(r4) :: FVAL - -allocate(data_3d(Nx,Ny,Nz)) -allocate(data_2d(Nx,Ny)) +integer :: ncid, iunit +integer :: dsize3, dsize2 ! size of 3d,2d variable if (.not. module_initialized) call static_init_trans +dsize3 = Nx*Ny*Nz +dsize2 = Nx*Ny + iunit = get_unit() call check(nf90_open("INPUT.nc",NF90_NOWRITE,ncid)) !Fill the data -call check( NF90_INQ_VARID(ncid,'PSAL',varid) ) -call check( NF90_GET_VAR(ncid,varid,data_3d)) -call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) -where (data_3d == FVAL) data_3d = 0.0_r4 - -open(iunit, file='PSAL.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') -write(iunit,rec=1)data_3d -close(iunit) - -call check( NF90_INQ_VARID(ncid,'PTMP',varid) ) -call check( NF90_GET_VAR(ncid,varid,data_3d)) -call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) -where (data_3d == FVAL) data_3d = 0.0_r4 - -open(iunit, file='PTMP.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') -write(iunit,rec=1)data_3d -close(iunit) - -call check( NF90_INQ_VARID(ncid,'UVEL',varid) ) -call check( NF90_GET_VAR(ncid,varid,data_3d)) -call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) -where (data_3d == FVAL) data_3d = 0.0_r4 - -open(iunit, file='UVEL.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') -write(iunit,rec=1)data_3d -close(iunit) - -call check( NF90_INQ_VARID(ncid,'VVEL',varid) ) -call check( NF90_GET_VAR(ncid,varid,data_3d)) -call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) -where (data_3d == FVAL) data_3d = 0.0_r4 - -open(iunit, file='VVEL.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') -write(iunit,rec=1)data_3d -close(iunit) - -call check( NF90_INQ_VARID(ncid,'ETA',varid) ) -call check( NF90_GET_VAR(ncid,varid,data_2d)) -call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) -where (data_2d == FVAL) data_2d = 0.0_r4 - -open(iunit, file='ETA.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') -write(iunit,rec=1)data_2d -close(iunit) - -if (do_bgc) then - call check( NF90_INQ_VARID(ncid,'NO3',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='NO3.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) - - call check( NF90_INQ_VARID(ncid,'PO4',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='PO4.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) - - call check( NF90_INQ_VARID(ncid,'O2',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='O2.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) - - call check( NF90_INQ_VARID(ncid,'PHY',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='PHY.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) - - call check( NF90_INQ_VARID(ncid,'ALK',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='ALK.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) - - call check( NF90_INQ_VARID(ncid,'DIC',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='DIC.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) - - call check( NF90_INQ_VARID(ncid,'DOP',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='DOP.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) - - call check( NF90_INQ_VARID(ncid,'DON',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='DON.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) - - call check( NF90_INQ_VARID(ncid,'FET',varid) ) - call check( NF90_GET_VAR(ncid,varid,data_3d)) - call check( nf90_get_att(ncid,varid,"_FillValue",FVAL)) - call fill_var_dm(data_3d, FVAL) - - open(iunit, file='FET.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') - write(iunit,rec=1)data_3d - close(iunit) +call from_netcdf_to_mit(ncid, 'PSAL', dsize3) +call from_netcdf_to_mit(ncid, 'PTMP', dsize3) +call from_netcdf_to_mit(ncid, 'UVEL', dsize3) +call from_netcdf_to_mit(ncid, 'VVEL', dsize3) +call from_netcdf_to_mit(ncid, 'ETA', dsize2) + + +if (do_bgc) then + call from_netcdf_to_mit_tracer(ncid, 'NO3', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'PO4', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'O2', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'PHY', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'ALK', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'DIC', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'DOP', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'DON', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'FET', dsize3) endif call check( NF90_CLOSE(ncid) ) -deallocate(data_3d) -deallocate(data_2d) - end subroutine dart2mit !=============================================================================== @@ -713,7 +463,6 @@ function define_variable(ncid, name, nc_type, all_dimids) result(varid) call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & dimids=all_dimids(6),varid=varid)) else - dimids = which_dims(name, all_dimids) call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & dimids=dimids, varid=varid)) @@ -778,58 +527,142 @@ subroutine add_attributes_to_variable(ncid, varid, long_name, units, units_long_ end subroutine -!=============================================================================== -!> Check the tracer variables after reading from the binaries -!> Make sure they are non-negative -!> Do the transform if requested -!> md: mit2dart; dm: dart2mit +!------------------------------------------------------------------ +subroutine from_mit_to_netcdf(mitfile, ncid, varid, datasize) -subroutine fill_var_md(var, fillval) +character(len=*), intent(in) :: mitfile +integer, intent(in) :: ncid, varid ! which file, which variable +integer, intent(in) :: datasize ! Nx*Ny*Nz, or Nx*Ny -real(r4), intent(inout) :: var(:, :, :) -real(r4), intent(in) :: fillval +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var_data(datasize) -real(r4) :: low_conc +recl = datasize*4 +iunit = get_unit() +! HK are the mit files big endian by default? +open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=recl, convert='BIG_ENDIAN') +read(iunit,rec=1) var_data +close(iunit) -if (.not. module_initialized) call static_init_trans +where (var_data == 0.0_r4) var_data = FVAL !HK do we also need a check for nans here? + +call check(nf90_put_var(ncid,varid,var_data)) + +end subroutine from_mit_to_netcdf + +!------------------------------------------------------------------ +subroutine from_mit_to_netcdf_tracer(mitfile, ncid, varid, datasize) + +character(len=*), intent(in) :: mitfile +integer, intent(in) :: ncid, varid ! which file, which variable +integer, intent(in) :: datasize ! Nx*Ny*Nz, or Nx*Ny + +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var(datasize) +real(r4) :: low_conc low_conc = 1.0e-12 -! Make sure the tracer concentration is positive +recl = datasize*4 +iunit = get_unit() +! HK are the mit files big endian by default? +open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=recl, convert='BIG_ENDIAN') +read(iunit,rec=1) var +close(iunit) + +! CHL is treated differently +if (mitfile=='CHL.data') then + where (var == 0.0_r4) + var = FVAL + elsewhere + var = log10(var) + endwhere + call check(nf90_put_var(ncid,varid,var)) + return +endif + +! Make sure the tracer concentration is positive where(var < 0.0_r4) var = low_conc if (log_transform) then where (var == 0.0_r4) - var = fillval + var = FVAL elsewhere var = log(var) endwhere else - where (var == 0.0_r4) var = fillval + where (var == 0.0_r4) var = FVAL endif -end subroutine +call check(nf90_put_var(ncid,varid,var)) + +end subroutine from_mit_to_netcdf_tracer !------------------------------------------------------------------ +subroutine from_netcdf_to_mit(ncid, name, datasize) -subroutine fill_var_dm(var, fillval) +integer, intent(in) :: ncid ! which file, +character(len=*), intent(in) :: name ! which variable +integer, intent(in) :: datasize ! Nx*Ny*Nz, or Nx*Ny -real(r4), intent(inout) :: var(:, :, :) -real(r4), intent(in) :: fillval +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var(datasize) +integer :: varid +real(r4) :: local_fval -if (.not. module_initialized) call static_init_trans +recl = datasize*4 +call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( NF90_GET_VAR(ncid,varid,var)) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) +where (var == local_fval) var = 0.0_r4 + +open(iunit, file=trim('name')//'.data', form="UNFORMATTED", status='UNKNOWN', & + access='DIRECT', recl=recl, convert='BIG_ENDIAN') +write(iunit,rec=1)var +close(iunit) + +end subroutine from_netcdf_to_mit + +!------------------------------------------------------------------ +subroutine from_netcdf_to_mit_tracer(ncid, name, datasize) + +integer, intent(in) :: ncid ! which file, +character(len=*), intent(in) :: name ! which variable +integer, intent(in) :: datasize ! Nx*Ny*Nz, or Nx*Ny + +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var(datasize) +integer :: varid +real(r4) :: local_fval + +recl = datasize*4 + +call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( NF90_GET_VAR(ncid,varid,var)) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) if (log_transform) then - where (var == fillval) + where (var == local_fval) var = 0.0_r4 elsewhere var = exp(var) endwhere else - where (var == fillval) var = 0.0_r4 + where (var == local_fval) var = 0.0_r4 endif -end subroutine +open(iunit, file=trim('name')//'.data', form="UNFORMATTED", status='UNKNOWN', & + access='DIRECT', recl=recl, convert='BIG_ENDIAN') +write(iunit,rec=1)var +close(iunit) + +end subroutine from_netcdf_to_mit_tracer !------------------------------------------------------------------ From e007252c4cb9b97d2e862e52b029e213584d70b1 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 25 Aug 2022 19:38:09 -0600 Subject: [PATCH 014/124] bug-fix: returns need to be inside if statement --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 77289f73a6..a9dbdedd6f 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -483,8 +483,14 @@ function which_dims(name, all_dimids) result(dimids) ! XG, YC, ZC 2 UVEL ! XC, YG, ZC 3 VVEL -if (name=='UVEL') dimids = (/all_dimids(4),all_dimids(2),all_dimids(3)/); return -if (name=='VVEL') dimids = (/all_dimids(1),all_dimids(5),all_dimids(3)/); return +if (name=='UVEL') then + dimids = (/all_dimids(4),all_dimids(2),all_dimids(3)/) + return +endif +if (name=='VVEL') then + dimids = (/all_dimids(1),all_dimids(5),all_dimids(3)/) + return +endif dimids = (/all_dimids(1),all_dimids(2),all_dimids(3)/) From fba76b4e977a32717a0ad23cb0ccbeccbf01a4f6 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 26 Aug 2022 09:56:25 -0600 Subject: [PATCH 015/124] bitwise mit_to_dart non-compressed with main, log and nolog --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 59 ++++++++++++++--------- 1 file changed, 37 insertions(+), 22 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index a9dbdedd6f..9b078c60ac 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -349,7 +349,7 @@ subroutine mit2dart() call add_attributes_to_variable(ncid, fet_varid, "Dissolved Inorganic Iron", "mol Fe/m3", "moles Iron per cubic meters") ! 10. BLING tracer: Surface Chlorophyl CHL - chl_varid = define_variable(ncid,"CHL", nf90_real, all_dimids) + chl_varid = define_variable_2d(ncid,"CHL", nf90_real, all_dimids) call add_attributes_to_variable(ncid, chl_varid, "Surface Chlorophyll", "mg/m3", "milligram per cubic meters" ) endif @@ -383,9 +383,10 @@ subroutine mit2dart() call from_mit_to_netcdf_tracer('PHY.data', ncid, phy_varid, dsize3) call from_mit_to_netcdf_tracer('ALK.data', ncid, alk_varid, dsize3) call from_mit_to_netcdf_tracer('DIC.data', ncid, dic_varid, dsize3) + call from_mit_to_netcdf_tracer('DOP.data', ncid, dop_varid, dsize3) call from_mit_to_netcdf_tracer('DON.data', ncid, don_varid, dsize3) call from_mit_to_netcdf_tracer('FET.data', ncid, fet_varid, dsize3) - call from_mit_to_netcdf_tracer('FET.data', ncid, fet_varid, dsize2) + call from_mit_to_netcdf_tracer('CHL.data', ncid, chl_varid, dsize2) endif call check(nf90_close(ncid)) @@ -554,7 +555,15 @@ subroutine from_mit_to_netcdf(mitfile, ncid, varid, datasize) where (var_data == 0.0_r4) var_data = FVAL !HK do we also need a check for nans here? -call check(nf90_put_var(ncid,varid,var_data)) +if (compress) then + call check(nf90_put_var(ncid,varid,var_data)) +else + if (datasize==Nx*Ny) then !2d + call check(nf90_put_var(ncid,varid,var_data,start=(/1,1/), count=(/Nx,Ny/) )) + else !3D + call check(nf90_put_var(ncid,varid,var_data,start=(/1,1,1/), count=(/Nx,Ny,Nz/) )) + endif +endif end subroutine from_mit_to_netcdf @@ -567,7 +576,7 @@ subroutine from_mit_to_netcdf_tracer(mitfile, ncid, varid, datasize) integer :: iunit integer :: recl ! datasize*4 -real(r4) :: var(datasize) +real(r4) :: var_data(datasize) real(r4) :: low_conc low_conc = 1.0e-12 @@ -577,35 +586,41 @@ subroutine from_mit_to_netcdf_tracer(mitfile, ncid, varid, datasize) ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl, convert='BIG_ENDIAN') -read(iunit,rec=1) var +read(iunit,rec=1) var_data close(iunit) ! CHL is treated differently if (mitfile=='CHL.data') then - where (var == 0.0_r4) - var = FVAL + where (var_data == 0.0_r4) + var_data = FVAL elsewhere - var = log10(var) + var_data = log10(var_data) endwhere - call check(nf90_put_var(ncid,varid,var)) - return +else + ! Make sure the tracer concentration is positive + where(var_data < 0.0_r4) var_data = low_conc + + if (log_transform) then + where (var_data == 0.0_r4) + var_data = FVAL + elsewhere + var_data = log(var_data) + endwhere + else + where (var_data == 0.0_r4) var_data = FVAL + endif endif -! Make sure the tracer concentration is positive -where(var < 0.0_r4) var = low_conc - -if (log_transform) then - where (var == 0.0_r4) - var = FVAL - elsewhere - var = log(var) - endwhere +if (compress) then + call check(nf90_put_var(ncid,varid,var_data)) else - where (var == 0.0_r4) var = FVAL + if (datasize==Nx*Ny) then !2d + call check(nf90_put_var(ncid,varid,var_data,start=(/1,1/), count=(/Nx,Ny/) )) + else !3D + call check(nf90_put_var(ncid,varid,var_data,start=(/1,1,1/), count=(/Nx,Ny,Nz/) )) + endif endif -call check(nf90_put_var(ncid,varid,var)) - end subroutine from_mit_to_netcdf_tracer !------------------------------------------------------------------ From 951235c1677fa6a8d4ccfac9350fe063b6f05d42 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 26 Aug 2022 11:00:45 -0600 Subject: [PATCH 016/124] bitwise with main dart_to_mit, no compression --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 25 +++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 9b078c60ac..0d7abb9ece 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -639,11 +639,20 @@ subroutine from_netcdf_to_mit(ncid, name, datasize) recl = datasize*4 call check( NF90_INQ_VARID(ncid,name,varid) ) -call check( NF90_GET_VAR(ncid,varid,var)) +if (compress) then + call check(nf90_get_var(ncid,varid,var)) +else + if (datasize==Nx*Ny) then !2d + call check(nf90_get_var(ncid,varid,var,start=(/1,1/), count=(/Nx,Ny/) )) + else !3D + call check(nf90_get_var(ncid,varid,var,start=(/1,1,1/), count=(/Nx,Ny,Nz/) )) + endif +endif + call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) where (var == local_fval) var = 0.0_r4 -open(iunit, file=trim('name')//'.data', form="UNFORMATTED", status='UNKNOWN', & +open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & access='DIRECT', recl=recl, convert='BIG_ENDIAN') write(iunit,rec=1)var close(iunit) @@ -666,7 +675,15 @@ subroutine from_netcdf_to_mit_tracer(ncid, name, datasize) recl = datasize*4 call check( NF90_INQ_VARID(ncid,name,varid) ) -call check( NF90_GET_VAR(ncid,varid,var)) +if (compress) then + call check(nf90_get_var(ncid,varid,var)) +else + if (datasize==Nx*Ny) then !2d + call check(nf90_get_var(ncid,varid,var,start=(/1,1/), count=(/Nx,Ny/) )) + else !3D + call check(nf90_get_var(ncid,varid,var,start=(/1,1,1/), count=(/Nx,Ny,Nz/) )) + endif +endif call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) if (log_transform) then where (var == local_fval) @@ -678,7 +695,7 @@ subroutine from_netcdf_to_mit_tracer(ncid, name, datasize) where (var == local_fval) var = 0.0_r4 endif -open(iunit, file=trim('name')//'.data', form="UNFORMATTED", status='UNKNOWN', & +open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & access='DIRECT', recl=recl, convert='BIG_ENDIAN') write(iunit,rec=1)var close(iunit) From 60c742c86870bbb3aecb12fa2e0280653d9b2c19 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 26 Aug 2022 17:00:29 -0600 Subject: [PATCH 017/124] size of compressed variables --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 73 ++++++++++++++++++++++- 1 file changed, 70 insertions(+), 3 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 0d7abb9ece..565af89bad 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -217,7 +217,7 @@ subroutine mit2dart() integer :: XGVarID, XCVarID, YGVarID, YCVarID, ZGVarID, ZCVarID integer :: comp2ID, comp3ID ! compressed dim integer :: all_dimids(7) ! store the 8 dimension ids - +integer :: ncomp2, ncomp3 ! length of compressed dim ! for the prognostic variables integer :: SVarID, TVarID, UVarID, VVarID, EtaVarID @@ -240,8 +240,14 @@ subroutine mit2dart() call check(nf90_def_dim(ncid=ncid, name="XG", len = Nx, dimid = XGDimID)) call check(nf90_def_dim(ncid=ncid, name="YG", len = Ny, dimid = YGDimID)) -call check(nf90_def_dim(ncid=ncid, name="comp2d", len = Nz, dimid = comp2ID)) -call check(nf90_def_dim(ncid=ncid, name="comp3d", len = Nz, dimid = comp3ID)) +if (compress) then + ncomp2 = get_compressed_size_2d() + ncomp3 = get_compressed_size_3d() +endif + + +call check(nf90_def_dim(ncid=ncid, name="comp2d", len = ncomp2, dimid = comp2ID)) +call check(nf90_def_dim(ncid=ncid, name="comp3d", len = ncomp3, dimid = comp3ID)) all_dimids = (/XCDimID, YCDimID, ZCDimID, XGDimID, YGDimID, comp2ID, comp3ID/) @@ -702,6 +708,67 @@ subroutine from_netcdf_to_mit_tracer(ncid, name, datasize) end subroutine from_netcdf_to_mit_tracer +!------------------------------------------------------------------ +! Assumes all 3D variables are masked in the +! same location +function get_compressed_size_3d() result(ncomp3) + +integer :: ncomp3 +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var3d(NX,NY,NZ) +integer :: i,j,k + +iunit = get_unit() +open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=Nx*Ny*Nz, convert='BIG_ENDIAN') +read(iunit,rec=1) ncomp3 +close(iunit) + +ncomp3 = 0 + +! Get compressed size +do i=1,NX + do j=1,NY + do k=1,NZ + if (var3d(i,j,k) /= -999.) then !HK also NaN? + ncomp3 = ncomp3 + 1 + endif + enddo + enddo +enddo + +end function get_compressed_size_3d + +!------------------------------------------------------------------ +! Assumes all 3D variables are masked in the +! same location +function get_compressed_size_2d() result(ncomp2) + +integer :: ncomp2 +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var2d(NX,NY) +integer :: i,j + +iunit = get_unit() +open(iunit, file='ETA.data', form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=Nx*Ny*4, convert='BIG_ENDIAN') +read(iunit,rec=1) var2d +close(iunit) + +ncomp2 = 0 + +! Get compressed size +do i=1,NX + do j=1,NY + if (var2d(i,j) /= -999.) then !HK also NaN? + ncomp2 = ncomp2 + 1 + endif + enddo +enddo + +end function get_compressed_size_2d !------------------------------------------------------------------ end module trans_mitdart_mod From 8b556ba64ac34f62c682ba94b87d048858b2f149 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Sun, 28 Aug 2022 18:56:05 -0600 Subject: [PATCH 018/124] partway through compressed write, I think separate writes for 2d vs 3d --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 45 ++++++++++++++++++----- 1 file changed, 35 insertions(+), 10 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 565af89bad..e6c926e70d 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -71,10 +71,11 @@ module trans_mitdart_mod ! standard MITgcm namelist and filled in here. integer :: Nx=-1, Ny=-1, Nz=-1 ! grid counts for each field +integer :: ncomp2, ncomp3 ! length of compressed dim ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) - +real(r8), allocatable :: XC_comp(:), XG_comp(:), YC_comp(:), YG_comp(:), ZC_comp(:), ZG_comp(:) ! 3D variables, 3 grids: ! @@ -217,7 +218,6 @@ subroutine mit2dart() integer :: XGVarID, XCVarID, YGVarID, YCVarID, ZGVarID, ZCVarID integer :: comp2ID, comp3ID ! compressed dim integer :: all_dimids(7) ! store the 8 dimension ids -integer :: ncomp2, ncomp3 ! length of compressed dim ! for the prognostic variables integer :: SVarID, TVarID, UVarID, VVarID, EtaVarID @@ -243,12 +243,10 @@ subroutine mit2dart() if (compress) then ncomp2 = get_compressed_size_2d() ncomp3 = get_compressed_size_3d() + call check(nf90_def_dim(ncid=ncid, name="comp2d", len = ncomp2, dimid = comp2ID)) + call check(nf90_def_dim(ncid=ncid, name="comp3d", len = ncomp3, dimid = comp3ID)) endif - -call check(nf90_def_dim(ncid=ncid, name="comp2d", len = ncomp2, dimid = comp2ID)) -call check(nf90_def_dim(ncid=ncid, name="comp3d", len = ncomp3, dimid = comp3ID)) - all_dimids = (/XCDimID, YCDimID, ZCDimID, XGDimID, YGDimID, comp2ID, comp3ID/) ! Create the (empty) Coordinate Variables and the Attributes @@ -371,7 +369,11 @@ subroutine mit2dart() call check(nf90_put_var(ncid, YCVarID, YC )) call check(nf90_put_var(ncid, ZCVarID, ZC )) -! Fill the data +if (compress) then + call check(nf90_put_var(ncid, comp2ID, XG_comp)) + call check(nf90_put_var(ncid, comp2ID, XC_comp)) +endif + dsize3 = Nx*Ny*Nz dsize2 = Nx*Ny @@ -468,7 +470,7 @@ function define_variable(ncid, name, nc_type, all_dimids) result(varid) if (compress) then call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & - dimids=all_dimids(6),varid=varid)) + dimids=all_dimids(7),varid=varid)) else dimids = which_dims(name, all_dimids) call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & @@ -518,7 +520,7 @@ function define_variable_2d(ncid, name, nc_type, all_dimids) result(varid) if (compress) then call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & - dimids = (/all_dimids(7)/),varid=varid)) + dimids = (/all_dimids(6)/),varid=varid)) else call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & dimids = (/all_dimids(1),all_dimids(2)/),varid=varid)) @@ -562,7 +564,7 @@ subroutine from_mit_to_netcdf(mitfile, ncid, varid, datasize) where (var_data == 0.0_r4) var_data = FVAL !HK do we also need a check for nans here? if (compress) then - call check(nf90_put_var(ncid,varid,var_data)) + call write_compressed(var_data, datasize) else if (datasize==Nx*Ny) then !2d call check(nf90_put_var(ncid,varid,var_data,start=(/1,1/), count=(/Nx,Ny/) )) @@ -769,7 +771,30 @@ function get_compressed_size_2d() result(ncomp2) enddo end function get_compressed_size_2d + +!------------------------------------------------------------------ +subroutine write_compressed_2d(var_data) + +real(r4), intent(in) :: var_data(Nx,Ny) + +real(r4) :: comp_var(ncomp2) + + + + +end subroutine write_compressed + !------------------------------------------------------------------ +subroutine write_compressed_3d(var_data) + +real(r4), intent(in) :: var_data(Nx,Ny,Nz) + +real(r4) :: comp_var(ncomp) + + + + +end subroutine write_compressed end module trans_mitdart_mod From b2394195bcb9f8b83744c22c69660c374e106902 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 29 Aug 2022 14:02:59 -0600 Subject: [PATCH 019/124] write compressed. untested. missing coord --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 365 ++++++++++++++++------ 1 file changed, 273 insertions(+), 92 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index e6c926e70d..b41f40229c 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -91,6 +91,16 @@ module trans_mitdart_mod public :: static_init_trans, mit2dart, dart2mit +interface write_compressed + module procedure write_compressed_2d + module procedure write_compressed_3d +end interface write_compressed + +interface read_compressed + module procedure read_compressed_2d + module procedure read_compressed_3d +end interface read_compressed + contains !================================================================== @@ -211,13 +221,13 @@ end subroutine static_init_trans subroutine mit2dart() integer :: ncid -integer :: dsize3, dsize2 ! size of 3d,2d variable ! for the dimensions and coordinate variables integer :: XGDimID, XCDimID, YGDimID, YCDimID, ZGDimID, ZCDimID integer :: XGVarID, XCVarID, YGVarID, YCVarID, ZGVarID, ZCVarID integer :: comp2ID, comp3ID ! compressed dim -integer :: all_dimids(7) ! store the 8 dimension ids +integer :: XGcompVarID, XCcompVarID, YGcompVarID, YCcompVarID, ZGcompVarID, ZCcompVarID +integer :: all_dimids(7) ! store the 7 dimension ids that are used ! for the prognostic variables integer :: SVarID, TVarID, UVarID, VVarID, EtaVarID @@ -294,6 +304,15 @@ subroutine mit2dart() call check(nf90_put_att(ncid, ZCVarID, "axis", "Z")) call check(nf90_put_att(ncid, ZCVarID, "standard_name", "depth")) +! Compressed grid variables +if (compress) then + call check(nf90_def_var(ncid,name="XGcomp",xtype=nf90_real,dimids=comp3ID,varid=XGcompVarID)) + call check(nf90_def_var(ncid,name="XCcomp",xtype=nf90_real,dimids=comp3ID,varid=XCcompVarID)) + call check(nf90_def_var(ncid,name="YGcomp",xtype=nf90_real,dimids=comp3ID,varid=YGcompVarID)) + call check(nf90_def_var(ncid,name="YCcomp",xtype=nf90_real,dimids=comp3ID,varid=YCcompVarID)) + call check(nf90_def_var(ncid,name="ZCcomp",xtype=nf90_double,dimids=comp3ID,varid=ZCcompVarID)) +endif + ! The size of these variables will depend on the compression ! Create the (empty) Prognostic Variables and the Attributes @@ -369,32 +388,33 @@ subroutine mit2dart() call check(nf90_put_var(ncid, YCVarID, YC )) call check(nf90_put_var(ncid, ZCVarID, ZC )) -if (compress) then - call check(nf90_put_var(ncid, comp2ID, XG_comp)) - call check(nf90_put_var(ncid, comp2ID, XC_comp)) -endif - -dsize3 = Nx*Ny*Nz -dsize2 = Nx*Ny - ! Fill the netcdf variables -call from_mit_to_netcdf('PSAL.data', ncid, SVarID, dsize3) -call from_mit_to_netcdf('PTMP.data', ncid, TVarID, dsize3) -call from_mit_to_netcdf('UVEL.data', ncid, UVarID, dsize3) -call from_mit_to_netcdf('VVEL.data', ncid, VVarID, dsize3) -call from_mit_to_netcdf('ETA.data', ncid, EtaVarID, dsize2) +call from_mit_to_netcdf_3d('PSAL.data', ncid, SVarID) +call from_mit_to_netcdf_3d('PTMP.data', ncid, TVarID) +call from_mit_to_netcdf_3d('UVEL.data', ncid, UVarID) +call from_mit_to_netcdf_3d('VVEL.data', ncid, VVarID) +call from_mit_to_netcdf_2d('ETA.data', ncid, EtaVarID) if (do_bgc) then - call from_mit_to_netcdf_tracer('NO3.data', ncid, no3_varid, dsize3) - call from_mit_to_netcdf_tracer('PO4.data', ncid, po4_varid, dsize3) - call from_mit_to_netcdf_tracer('O2.data', ncid, o2_varid, dsize3) - call from_mit_to_netcdf_tracer('PHY.data', ncid, phy_varid, dsize3) - call from_mit_to_netcdf_tracer('ALK.data', ncid, alk_varid, dsize3) - call from_mit_to_netcdf_tracer('DIC.data', ncid, dic_varid, dsize3) - call from_mit_to_netcdf_tracer('DOP.data', ncid, dop_varid, dsize3) - call from_mit_to_netcdf_tracer('DON.data', ncid, don_varid, dsize3) - call from_mit_to_netcdf_tracer('FET.data', ncid, fet_varid, dsize3) - call from_mit_to_netcdf_tracer('CHL.data', ncid, chl_varid, dsize2) + call from_mit_to_netcdf_tracer_3d('NO3.data', ncid, no3_varid) + call from_mit_to_netcdf_tracer_3d('PO4.data', ncid, po4_varid) + call from_mit_to_netcdf_tracer_3d('O2.data', ncid, o2_varid) + call from_mit_to_netcdf_tracer_3d('PHY.data', ncid, phy_varid) + call from_mit_to_netcdf_tracer_3d('ALK.data', ncid, alk_varid) + call from_mit_to_netcdf_tracer_3d('DIC.data', ncid, dic_varid) + call from_mit_to_netcdf_tracer_3d('DOP.data', ncid, dop_varid) + call from_mit_to_netcdf_tracer_3d('DON.data', ncid, don_varid) + call from_mit_to_netcdf_tracer_3d('FET.data', ncid, fet_varid) + call from_mit_to_netcdf_tracer_2d('CHL.data', ncid, chl_varid) +endif + +if (compress) then + call fill_comp_coord() + call check(nf90_put_var(ncid, comp3ID, XG_comp)) + call check(nf90_put_var(ncid, comp3ID, XC_comp)) + call check(nf90_put_var(ncid, YGVarID, YG_comp)) + call check(nf90_put_var(ncid, YCVarID, YC_comp)) + call check(nf90_put_var(ncid, ZCVarID, ZC_comp)) endif call check(nf90_close(ncid)) @@ -407,34 +427,30 @@ end subroutine mit2dart subroutine dart2mit() integer :: ncid, iunit -integer :: dsize3, dsize2 ! size of 3d,2d variable if (.not. module_initialized) call static_init_trans -dsize3 = Nx*Ny*Nz -dsize2 = Nx*Ny - iunit = get_unit() call check(nf90_open("INPUT.nc",NF90_NOWRITE,ncid)) !Fill the data -call from_netcdf_to_mit(ncid, 'PSAL', dsize3) -call from_netcdf_to_mit(ncid, 'PTMP', dsize3) -call from_netcdf_to_mit(ncid, 'UVEL', dsize3) -call from_netcdf_to_mit(ncid, 'VVEL', dsize3) -call from_netcdf_to_mit(ncid, 'ETA', dsize2) +call from_netcdf_to_mit_3d(ncid, 'PSAL') +call from_netcdf_to_mit_3d(ncid, 'PTMP') +call from_netcdf_to_mit_3d(ncid, 'UVEL') +call from_netcdf_to_mit_3d(ncid, 'VVEL') +call from_netcdf_to_mit_2d(ncid, 'ETA') if (do_bgc) then - call from_netcdf_to_mit_tracer(ncid, 'NO3', dsize3) - call from_netcdf_to_mit_tracer(ncid, 'PO4', dsize3) - call from_netcdf_to_mit_tracer(ncid, 'O2', dsize3) - call from_netcdf_to_mit_tracer(ncid, 'PHY', dsize3) - call from_netcdf_to_mit_tracer(ncid, 'ALK', dsize3) - call from_netcdf_to_mit_tracer(ncid, 'DIC', dsize3) - call from_netcdf_to_mit_tracer(ncid, 'DOP', dsize3) - call from_netcdf_to_mit_tracer(ncid, 'DON', dsize3) - call from_netcdf_to_mit_tracer(ncid, 'FET', dsize3) + call from_netcdf_to_mit_tracer(ncid, 'NO3') + call from_netcdf_to_mit_tracer(ncid, 'PO4') + call from_netcdf_to_mit_tracer(ncid, 'O2') + call from_netcdf_to_mit_tracer(ncid, 'PHY') + call from_netcdf_to_mit_tracer(ncid, 'ALK') + call from_netcdf_to_mit_tracer(ncid, 'DIC') + call from_netcdf_to_mit_tracer(ncid, 'DOP') + call from_netcdf_to_mit_tracer(ncid, 'DON') + call from_netcdf_to_mit_tracer(ncid, 'FET') endif call check( NF90_CLOSE(ncid) ) @@ -543,17 +559,16 @@ subroutine add_attributes_to_variable(ncid, varid, long_name, units, units_long_ end subroutine !------------------------------------------------------------------ -subroutine from_mit_to_netcdf(mitfile, ncid, varid, datasize) +subroutine from_mit_to_netcdf_3d(mitfile, ncid, varid) character(len=*), intent(in) :: mitfile integer, intent(in) :: ncid, varid ! which file, which variable -integer, intent(in) :: datasize ! Nx*Ny*Nz, or Nx*Ny integer :: iunit integer :: recl ! datasize*4 -real(r4) :: var_data(datasize) +real(r4) :: var_data(Nx,Ny,Nz) -recl = datasize*4 +recl = Nx*Ny*Ny*4 iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & @@ -564,32 +579,56 @@ subroutine from_mit_to_netcdf(mitfile, ncid, varid, datasize) where (var_data == 0.0_r4) var_data = FVAL !HK do we also need a check for nans here? if (compress) then - call write_compressed(var_data, datasize) + call write_compressed(ncid, varid, var_data) else - if (datasize==Nx*Ny) then !2d - call check(nf90_put_var(ncid,varid,var_data,start=(/1,1/), count=(/Nx,Ny/) )) - else !3D - call check(nf90_put_var(ncid,varid,var_data,start=(/1,1,1/), count=(/Nx,Ny,Nz/) )) - endif + call check(nf90_put_var(ncid,varid,var_data)) endif -end subroutine from_mit_to_netcdf +end subroutine from_mit_to_netcdf_3d !------------------------------------------------------------------ -subroutine from_mit_to_netcdf_tracer(mitfile, ncid, varid, datasize) +subroutine from_mit_to_netcdf_2d(mitfile, ncid, varid) character(len=*), intent(in) :: mitfile integer, intent(in) :: ncid, varid ! which file, which variable -integer, intent(in) :: datasize ! Nx*Ny*Nz, or Nx*Ny integer :: iunit integer :: recl ! datasize*4 -real(r4) :: var_data(datasize) +real(r4) :: var_data(Nx,Ny) + +recl = Nx*Ny*4 +iunit = get_unit() +! HK are the mit files big endian by default? +open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=recl, convert='BIG_ENDIAN') +read(iunit,rec=1) var_data +close(iunit) + +where (var_data == 0.0_r4) var_data = FVAL !HK do we also need a check for nans here? + +if (compress) then + call write_compressed(ncid, varid, var_data) +else + call check(nf90_put_var(ncid,varid,var_data)) +endif + +end subroutine from_mit_to_netcdf_2d + + +!------------------------------------------------------------------ +subroutine from_mit_to_netcdf_tracer_3d(mitfile, ncid, varid) + +character(len=*), intent(in) :: mitfile +integer, intent(in) :: ncid, varid ! which file, which variable + +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var_data(Nx,Ny,Nz) real(r4) :: low_conc low_conc = 1.0e-12 -recl = datasize*4 +recl = Nx*Ny*Nz*4 iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & @@ -620,41 +659,83 @@ subroutine from_mit_to_netcdf_tracer(mitfile, ncid, varid, datasize) endif if (compress) then - call check(nf90_put_var(ncid,varid,var_data)) + call write_compressed(ncid, varid, var_data) +else + call check(nf90_put_var(ncid,varid,var_data)) +endif + +end subroutine from_mit_to_netcdf_tracer_3d + +!------------------------------------------------------------------ +subroutine from_mit_to_netcdf_tracer_2d(mitfile, ncid, varid) + +character(len=*), intent(in) :: mitfile +integer, intent(in) :: ncid, varid ! which file, which variable + +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var_data(Nx,Ny) +real(r4) :: low_conc + +low_conc = 1.0e-12 + +recl = Nx*Ny*Nz*4 +iunit = get_unit() +! HK are the mit files big endian by default? +open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=recl, convert='BIG_ENDIAN') +read(iunit,rec=1) var_data +close(iunit) + +! CHL is treated differently +if (mitfile=='CHL.data') then + where (var_data == 0.0_r4) + var_data = FVAL + elsewhere + var_data = log10(var_data) + endwhere +else + ! Make sure the tracer concentration is positive + where(var_data < 0.0_r4) var_data = low_conc + + if (log_transform) then + where (var_data == 0.0_r4) + var_data = FVAL + elsewhere + var_data = log(var_data) + endwhere + else + where (var_data == 0.0_r4) var_data = FVAL + endif +endif + +if (compress) then + call write_compressed(ncid, varid, var_data) else - if (datasize==Nx*Ny) then !2d - call check(nf90_put_var(ncid,varid,var_data,start=(/1,1/), count=(/Nx,Ny/) )) - else !3D - call check(nf90_put_var(ncid,varid,var_data,start=(/1,1,1/), count=(/Nx,Ny,Nz/) )) - endif + call check(nf90_put_var(ncid,varid,var_data)) endif -end subroutine from_mit_to_netcdf_tracer +end subroutine from_mit_to_netcdf_tracer_2d !------------------------------------------------------------------ -subroutine from_netcdf_to_mit(ncid, name, datasize) +subroutine from_netcdf_to_mit_2d(ncid, name) integer, intent(in) :: ncid ! which file, character(len=*), intent(in) :: name ! which variable -integer, intent(in) :: datasize ! Nx*Ny*Nz, or Nx*Ny integer :: iunit integer :: recl ! datasize*4 -real(r4) :: var(datasize) +real(r4) :: var(Nx,Ny) integer :: varid real(r4) :: local_fval -recl = datasize*4 +recl = Nx*Ny*4 call check( NF90_INQ_VARID(ncid,name,varid) ) if (compress) then - call check(nf90_get_var(ncid,varid,var)) + call read_compressed(ncid, varid, var) else - if (datasize==Nx*Ny) then !2d - call check(nf90_get_var(ncid,varid,var,start=(/1,1/), count=(/Nx,Ny/) )) - else !3D - call check(nf90_get_var(ncid,varid,var,start=(/1,1,1/), count=(/Nx,Ny,Nz/) )) - endif + call check(nf90_get_var(ncid,varid,var)) endif call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) @@ -665,33 +746,61 @@ subroutine from_netcdf_to_mit(ncid, name, datasize) write(iunit,rec=1)var close(iunit) -end subroutine from_netcdf_to_mit +end subroutine from_netcdf_to_mit_2d !------------------------------------------------------------------ -subroutine from_netcdf_to_mit_tracer(ncid, name, datasize) +subroutine from_netcdf_to_mit_3d(ncid, name) integer, intent(in) :: ncid ! which file, character(len=*), intent(in) :: name ! which variable -integer, intent(in) :: datasize ! Nx*Ny*Nz, or Nx*Ny integer :: iunit integer :: recl ! datasize*4 -real(r4) :: var(datasize) +real(r4) :: var(Nx,Ny,Nz) integer :: varid real(r4) :: local_fval -recl = datasize*4 +recl = Nx*Ny*Nz*4 call check( NF90_INQ_VARID(ncid,name,varid) ) if (compress) then - call check(nf90_get_var(ncid,varid,var)) + call read_compressed(ncid, varid, var) else - if (datasize==Nx*Ny) then !2d - call check(nf90_get_var(ncid,varid,var,start=(/1,1/), count=(/Nx,Ny/) )) - else !3D - call check(nf90_get_var(ncid,varid,var,start=(/1,1,1/), count=(/Nx,Ny,Nz/) )) - endif + call check(nf90_get_var(ncid,varid,var)) endif + +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) +where (var == local_fval) var = 0.0_r4 + +open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & + access='DIRECT', recl=recl, convert='BIG_ENDIAN') +write(iunit,rec=1)var +close(iunit) + +end subroutine from_netcdf_to_mit_3d + + +!------------------------------------------------------------------ +subroutine from_netcdf_to_mit_tracer(ncid, name) + +integer, intent(in) :: ncid ! which file, +character(len=*), intent(in) :: name ! which variable + +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var(Nx,Ny,Nz) +integer :: varid +real(r4) :: local_fval + +recl = Nx*Ny*Nz*4 + +call check( NF90_INQ_VARID(ncid,name,varid) ) +if (compress) then + call read_compressed(ncid, varid, var) +else + call check(nf90_get_var(ncid,varid,var)) +endif + call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) if (log_transform) then where (var == local_fval) @@ -773,28 +882,100 @@ function get_compressed_size_2d() result(ncomp2) end function get_compressed_size_2d !------------------------------------------------------------------ -subroutine write_compressed_2d(var_data) +subroutine write_compressed_2d(ncid, varid, var_data) +integer, intent(in) :: ncid, varid real(r4), intent(in) :: var_data(Nx,Ny) real(r4) :: comp_var(ncomp2) +integer :: n +integer :: i,j ! loop variables + +n = 1 +do i = 1, NX + do j = 1, NY + if (var_data(i,j) /= -999.) then !HK check for nans? + comp_var(n) = var_data(i,j) + n = n + 1 + endif + enddo +enddo + +call check(nf90_put_var(ncid,varid,comp_var)) +end subroutine write_compressed_2d +!------------------------------------------------------------------ +subroutine write_compressed_3d(ncid, varid, var_data) + +integer, intent(in) :: ncid, varid +real(r4), intent(in) :: var_data(Nx,Ny,Nz) +real(r4) :: comp_var(ncomp3) +integer :: n +integer :: i,j,k ! loop variables + +n = 1 +do i = 1, NX + do j = 1, NY + do k = 1 , NZ + if (var_data(i,j,k) /= -999.) then !HK check for nans? + comp_var(n) = var_data(i,j,k) + n = n + 1 + endif + enddo + enddo +enddo -end subroutine write_compressed +call check(nf90_put_var(ncid,varid,comp_var)) + +end subroutine write_compressed_3d !------------------------------------------------------------------ -subroutine write_compressed_3d(var_data) +subroutine read_compressed_2d(ncid, varid, var) -real(r4), intent(in) :: var_data(Nx,Ny,Nz) +integer, intent(in) :: ncid, varid +real(r4), intent(out) :: var(NX,NY) + +real(r4) :: comp_var(ncomp2) +integer :: n +integer :: i,j,k ! loop variables + +call check(nf90_get_var(ncid,varid,comp_var)) + +! Need to read in compressed dimensions +n = 1 + +var(i,j) = comp_var(n) + +end subroutine read_compressed_2d + +!------------------------------------------------------------------ +subroutine read_compressed_3d(ncid, varid, var) + +integer, intent(in) :: ncid, varid +real(r4), intent(out) :: var(NX,NY,NZ) + +real(r4) :: comp_var(ncomp3) +integer :: n +integer :: i,j,k ! loop variables + +call check(nf90_get_var(ncid,varid,comp_var)) + +! Need to read in compressed dimensions +n = 1 + +var(i,j,k) = comp_var(n) + +end subroutine read_compressed_3d +!------------------------------------------------------------------ -real(r4) :: comp_var(ncomp) +subroutine fill_comp_coord() +end subroutine fill_comp_coord -end subroutine write_compressed end module trans_mitdart_mod From 1a7bf39dc80e6d99bb3ebc0ca309b249f0c60b47 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 30 Aug 2022 14:35:43 -0600 Subject: [PATCH 020/124] note on delX,Y - does delX,Y vary? --- models/MITgcm_ocean/model_mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index 63d44b04f2..2dffd80a1c 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -551,7 +551,7 @@ subroutine static_init_model() ! EL: tentative solution of XG values do i=1, xcsqsize - XG_sq(i) = XC_sq(i) - 0.5*delX(1) + XG_sq(i) = XC_sq(i) - 0.5*delX(1) ! HK should this be delX(i)? YG_sq(i) = YC_sq(i) - 0.5*delY(1) enddo From d4c39056746ab7003ca1bd303efff2ecac639943 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Aug 2022 14:32:10 -0600 Subject: [PATCH 021/124] record indices for X,Y,Z used when uncompressing --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 138 ++++++++++++++++------ 1 file changed, 104 insertions(+), 34 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index b41f40229c..305adf73f1 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -9,6 +9,7 @@ module trans_mitdart_mod use utilities_mod, only: initialize_utilities, register_module, & get_unit, find_namelist_in_file, file_exist, & check_namelist_read +use netcdf_utilities_mod, only : nc_get_variable use netcdf implicit none @@ -71,11 +72,12 @@ module trans_mitdart_mod ! standard MITgcm namelist and filled in here. integer :: Nx=-1, Ny=-1, Nz=-1 ! grid counts for each field -integer :: ncomp2, ncomp3 ! length of compressed dim +integer :: ncomp2=-1, ncomp3=-1 ! length of compressed dim ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) -real(r8), allocatable :: XC_comp(:), XG_comp(:), YC_comp(:), YG_comp(:), ZC_comp(:), ZG_comp(:) +real(r8), allocatable :: XCcomp(:), XGcomp(:), YCcomp(:), YGcomp(:), ZCcomp(:), ZGcomp(:) +real(r8), allocatable :: Xcomp_ind(:), Ycomp_ind(:), Zcomp_ind(:) !HK are the staggered grids compressed the same? ! 3D variables, 3 grids: ! @@ -227,6 +229,7 @@ subroutine mit2dart() integer :: XGVarID, XCVarID, YGVarID, YCVarID, ZGVarID, ZCVarID integer :: comp2ID, comp3ID ! compressed dim integer :: XGcompVarID, XCcompVarID, YGcompVarID, YCcompVarID, ZGcompVarID, ZCcompVarID +integer :: XindID, YindID, ZindID integer :: all_dimids(7) ! store the 7 dimension ids that are used ! for the prognostic variables @@ -311,6 +314,9 @@ subroutine mit2dart() call check(nf90_def_var(ncid,name="YGcomp",xtype=nf90_real,dimids=comp3ID,varid=YGcompVarID)) call check(nf90_def_var(ncid,name="YCcomp",xtype=nf90_real,dimids=comp3ID,varid=YCcompVarID)) call check(nf90_def_var(ncid,name="ZCcomp",xtype=nf90_double,dimids=comp3ID,varid=ZCcompVarID)) + call check(nf90_def_var(ncid,name="Xcomp_ind",xtype=nf90_real,dimids=comp3ID,varid=XindID)) + call check(nf90_def_var(ncid,name="Ycomp_ind",xtype=nf90_real,dimids=comp3ID,varid=YindID)) + call check(nf90_def_var(ncid,name="Zcomp_ind",xtype=nf90_real,dimids=comp3ID,varid=ZindID)) endif ! The size of these variables will depend on the compression @@ -388,6 +394,27 @@ subroutine mit2dart() call check(nf90_put_var(ncid, YCVarID, YC )) call check(nf90_put_var(ncid, ZCVarID, ZC )) +if (compress) then + allocate(XCcomp(ncomp3)) + allocate(XGcomp(ncomp3)) + allocate(YCcomp(ncomp3)) + allocate(YGcomp(ncomp3)) + allocate(ZCcomp(ncomp3)) + allocate(ZGcomp(ncomp3)) + allocate(Xcomp_ind(ncomp3)) + allocate(Ycomp_ind(ncomp3)) + allocate(Zcomp_ind(ncomp3)) + call fill_compressed_coords() + call check(nf90_put_var(ncid, XGcompVarID, XGcomp )) + call check(nf90_put_var(ncid, XCcompVarID, XCcomp )) + call check(nf90_put_var(ncid, YGcompVarID, YGcomp )) + call check(nf90_put_var(ncid, YCcompVarID, YCcomp )) + call check(nf90_put_var(ncid, ZCcompVarID, ZCcomp )) + call check(nf90_put_var(ncid, ZCcompVarID, Xcomp_ind )) + call check(nf90_put_var(ncid, ZCcompVarID, Ycomp_ind )) + call check(nf90_put_var(ncid, ZCcompVarID, Zcomp_ind )) +endif + ! Fill the netcdf variables call from_mit_to_netcdf_3d('PSAL.data', ncid, SVarID) call from_mit_to_netcdf_3d('PTMP.data', ncid, TVarID) @@ -408,15 +435,6 @@ subroutine mit2dart() call from_mit_to_netcdf_tracer_2d('CHL.data', ncid, chl_varid) endif -if (compress) then - call fill_comp_coord() - call check(nf90_put_var(ncid, comp3ID, XG_comp)) - call check(nf90_put_var(ncid, comp3ID, XC_comp)) - call check(nf90_put_var(ncid, YGVarID, YG_comp)) - call check(nf90_put_var(ncid, YCVarID, YC_comp)) - call check(nf90_put_var(ncid, ZCVarID, ZC_comp)) -endif - call check(nf90_close(ncid)) end subroutine mit2dart @@ -433,6 +451,15 @@ subroutine dart2mit() iunit = get_unit() call check(nf90_open("INPUT.nc",NF90_NOWRITE,ncid)) +if (compress) then + allocate(Xcomp_ind(ncomp3)) + allocate(Ycomp_ind(ncomp3)) + allocate(Zcomp_ind(ncomp3)) + call nc_get_variable(ncid, 'Xcomp_ind', Xcomp_ind) + call nc_get_variable(ncid, 'Ycomp_ind', Ycomp_ind) + call nc_get_variable(ncid, 'Zcomp_ind', Zcomp_ind) +endif + !Fill the data call from_netcdf_to_mit_3d(ncid, 'PSAL') call from_netcdf_to_mit_3d(ncid, 'PTMP') @@ -455,6 +482,8 @@ subroutine dart2mit() call check( NF90_CLOSE(ncid) ) +deallocate(Xcomp_ind, Ycomp_ind, Zcomp_ind) + end subroutine dart2mit !=============================================================================== @@ -736,10 +765,11 @@ subroutine from_netcdf_to_mit_2d(ncid, name) call read_compressed(ncid, varid, var) else call check(nf90_get_var(ncid,varid,var)) + call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) + where (var == local_fval) var = 0.0_r4 endif -call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) -where (var == local_fval) var = 0.0_r4 + open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & access='DIRECT', recl=recl, convert='BIG_ENDIAN') @@ -833,7 +863,7 @@ function get_compressed_size_3d() result(ncomp3) iunit = get_unit() open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & access='DIRECT', recl=Nx*Ny*Nz, convert='BIG_ENDIAN') -read(iunit,rec=1) ncomp3 +read(iunit,rec=1) var3d close(iunit) ncomp3 = 0 @@ -881,6 +911,45 @@ function get_compressed_size_2d() result(ncomp2) end function get_compressed_size_2d +!------------------------------------------------------------------ +subroutine fill_compressed_coords() + +!XG,etc read from PARAM04 in static_init_trans +real(r4) :: var3d(NX,NY,NZ) +real(r4) :: var2d(NX,NY) +integer :: n, i, j, k + +iunit = get_unit() +open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=Nx*Ny*Nz, convert='BIG_ENDIAN') +read(iunit,rec=1) var3d +close(iunit) + +n = 1 + +do i=1,NX + do j=1,NY + do k=1,NZ + if (var3d(i,j,k) /= -999.) then !HK also NaN? + XCcomp(n) = XC(i) + YCcomp(n) = YC(j) + ZCcomp(n) = ZC(k) + XGcomp(n) = XG(i) + YGcomp(n) = YG(j) + ZGcomp(n) = ZG(k) + + Xcomp_ind(n) = i ! Assuming grids are compressed the same + Ycomp_ind(n) = j + Zcomp_ind(n) = k + + n = n + 1 + endif + enddo + enddo +enddo + +end subroutine fill_compressed_coords + !------------------------------------------------------------------ subroutine write_compressed_2d(ncid, varid, var_data) @@ -938,15 +1007,19 @@ subroutine read_compressed_2d(ncid, varid, var) real(r4), intent(out) :: var(NX,NY) real(r4) :: comp_var(ncomp2) -integer :: n -integer :: i,j,k ! loop variables +integer :: n ! loop variable +integer :: i,j ! x,y -call check(nf90_get_var(ncid,varid,comp_var)) +! initialize var to 0 +var(:,:) = 0.0_r4 -! Need to read in compressed dimensions -n = 1 +call check(nf90_get_var(ncid,varid,comp_var)) -var(i,j) = comp_var(n) +do n = 1, ncomp2 + i = Xcomp_ind(n) + j = Ycomp_ind(n) + var(i,j) = comp_var(n) +enddo end subroutine read_compressed_2d @@ -957,25 +1030,22 @@ subroutine read_compressed_3d(ncid, varid, var) real(r4), intent(out) :: var(NX,NY,NZ) real(r4) :: comp_var(ncomp3) -integer :: n -integer :: i,j,k ! loop variables +integer :: n ! loop variable +integer :: i,j,k ! x,y,k -call check(nf90_get_var(ncid,varid,comp_var)) +! initialize var to 0 +var(:,:,:) = 0.0_r4 -! Need to read in compressed dimensions -n = 1 +call check(nf90_get_var(ncid,varid,comp_var)) -var(i,j,k) = comp_var(n) +do n = 1, ncomp2 + i = Xcomp_ind(n) + j = Ycomp_ind(n) + k = Zcomp_ind(n) + var(i,j,k) = comp_var(n) +enddo end subroutine read_compressed_3d -!------------------------------------------------------------------ - -subroutine fill_comp_coord() - - - -end subroutine fill_comp_coord - end module trans_mitdart_mod From 39568db485da03b42e9eb8c4422e3d1f938c7bc2 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Aug 2022 15:18:49 -0600 Subject: [PATCH 022/124] compressing out vals=0.0 integers for coord index --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 305adf73f1..b03624b44a 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -28,6 +28,7 @@ module trans_mitdart_mod namelist /trans_mitdart_nml/ do_bgc, log_transform, compress real(r4), parameter :: FVAL=-999.0_r4 ! may put this as a namelist option +real(r4), parameter :: binary_fill=0.0_r4 !------------------------------------------------------------------ ! @@ -77,7 +78,7 @@ module trans_mitdart_mod ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) real(r8), allocatable :: XCcomp(:), XGcomp(:), YCcomp(:), YGcomp(:), ZCcomp(:), ZGcomp(:) -real(r8), allocatable :: Xcomp_ind(:), Ycomp_ind(:), Zcomp_ind(:) !HK are the staggered grids compressed the same? +integer, allocatable :: Xcomp_ind(:), Ycomp_ind(:), Zcomp_ind(:) !HK are the staggered grids compressed the same? ! 3D variables, 3 grids: ! @@ -314,9 +315,9 @@ subroutine mit2dart() call check(nf90_def_var(ncid,name="YGcomp",xtype=nf90_real,dimids=comp3ID,varid=YGcompVarID)) call check(nf90_def_var(ncid,name="YCcomp",xtype=nf90_real,dimids=comp3ID,varid=YCcompVarID)) call check(nf90_def_var(ncid,name="ZCcomp",xtype=nf90_double,dimids=comp3ID,varid=ZCcompVarID)) - call check(nf90_def_var(ncid,name="Xcomp_ind",xtype=nf90_real,dimids=comp3ID,varid=XindID)) - call check(nf90_def_var(ncid,name="Ycomp_ind",xtype=nf90_real,dimids=comp3ID,varid=YindID)) - call check(nf90_def_var(ncid,name="Zcomp_ind",xtype=nf90_real,dimids=comp3ID,varid=ZindID)) + call check(nf90_def_var(ncid,name="Xcomp_ind",xtype=nf90_int,dimids=comp3ID,varid=XindID)) + call check(nf90_def_var(ncid,name="Ycomp_ind",xtype=nf90_int,dimids=comp3ID,varid=YindID)) + call check(nf90_def_var(ncid,name="Zcomp_ind",xtype=nf90_int,dimids=comp3ID,varid=ZindID)) endif ! The size of these variables will depend on the compression @@ -872,7 +873,7 @@ function get_compressed_size_3d() result(ncomp3) do i=1,NX do j=1,NY do k=1,NZ - if (var3d(i,j,k) /= -999.) then !HK also NaN? + if (var3d(i,j,k) /= binary_fill) then !HK also NaN? ncomp3 = ncomp3 + 1 endif enddo @@ -903,7 +904,7 @@ function get_compressed_size_2d() result(ncomp2) ! Get compressed size do i=1,NX do j=1,NY - if (var2d(i,j) /= -999.) then !HK also NaN? + if (var2d(i,j) /= binary_fill) then !HK also NaN? ncomp2 = ncomp2 + 1 endif enddo @@ -930,7 +931,7 @@ subroutine fill_compressed_coords() do i=1,NX do j=1,NY do k=1,NZ - if (var3d(i,j,k) /= -999.) then !HK also NaN? + if (var3d(i,j,k) /= binary_fill) then !HK also NaN? XCcomp(n) = XC(i) YCcomp(n) = YC(j) ZCcomp(n) = ZC(k) @@ -963,7 +964,7 @@ subroutine write_compressed_2d(ncid, varid, var_data) n = 1 do i = 1, NX do j = 1, NY - if (var_data(i,j) /= -999.) then !HK check for nans? + if (var_data(i,j) /= binary_fill) then !HK check for nans? comp_var(n) = var_data(i,j) n = n + 1 endif @@ -988,7 +989,7 @@ subroutine write_compressed_3d(ncid, varid, var_data) do i = 1, NX do j = 1, NY do k = 1 , NZ - if (var_data(i,j,k) /= -999.) then !HK check for nans? + if (var_data(i,j,k) /= binary_fill) then !HK check for nans? comp_var(n) = var_data(i,j,k) n = n + 1 endif From 329cd4298f8a9af1c470b0b02a28a26ffc0f25fb Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Aug 2022 16:02:09 -0600 Subject: [PATCH 023/124] replace hardcoded 0.0_r8 with binary_fill variable --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 45 ++++++++++++----------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index b03624b44a..fe6a2d4684 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -259,6 +259,9 @@ subroutine mit2dart() ncomp3 = get_compressed_size_3d() call check(nf90_def_dim(ncid=ncid, name="comp2d", len = ncomp2, dimid = comp2ID)) call check(nf90_def_dim(ncid=ncid, name="comp3d", len = ncomp3, dimid = comp3ID)) +else + comp2ID = -1 + comp3ID = -1 endif all_dimids = (/XCDimID, YCDimID, ZCDimID, XGDimID, YGDimID, comp2ID, comp3ID/) @@ -445,11 +448,10 @@ end subroutine mit2dart subroutine dart2mit() -integer :: ncid, iunit +integer :: ncid if (.not. module_initialized) call static_init_trans -iunit = get_unit() call check(nf90_open("INPUT.nc",NF90_NOWRITE,ncid)) if (compress) then @@ -483,7 +485,7 @@ subroutine dart2mit() call check( NF90_CLOSE(ncid) ) -deallocate(Xcomp_ind, Ycomp_ind, Zcomp_ind) +if (compress) deallocate(Xcomp_ind, Ycomp_ind, Zcomp_ind) end subroutine dart2mit @@ -606,7 +608,7 @@ subroutine from_mit_to_netcdf_3d(mitfile, ncid, varid) read(iunit,rec=1) var_data close(iunit) -where (var_data == 0.0_r4) var_data = FVAL !HK do we also need a check for nans here? +where (var_data == binary_fill) var_data = FVAL !HK do we also need a check for nans here? if (compress) then call write_compressed(ncid, varid, var_data) @@ -634,7 +636,7 @@ subroutine from_mit_to_netcdf_2d(mitfile, ncid, varid) read(iunit,rec=1) var_data close(iunit) -where (var_data == 0.0_r4) var_data = FVAL !HK do we also need a check for nans here? +where (var_data == binary_fill) var_data = FVAL !HK do we also need a check for nans here? if (compress) then call write_compressed(ncid, varid, var_data) @@ -668,23 +670,23 @@ subroutine from_mit_to_netcdf_tracer_3d(mitfile, ncid, varid) ! CHL is treated differently if (mitfile=='CHL.data') then - where (var_data == 0.0_r4) + where (var_data == binary_fill) var_data = FVAL elsewhere var_data = log10(var_data) endwhere else ! Make sure the tracer concentration is positive - where(var_data < 0.0_r4) var_data = low_conc + where(var_data < binary_fill) var_data = low_conc if (log_transform) then - where (var_data == 0.0_r4) + where (var_data == binary_fill) var_data = FVAL elsewhere var_data = log(var_data) endwhere else - where (var_data == 0.0_r4) var_data = FVAL + where (var_data == binary_fill) var_data = FVAL endif endif @@ -719,14 +721,14 @@ subroutine from_mit_to_netcdf_tracer_2d(mitfile, ncid, varid) ! CHL is treated differently if (mitfile=='CHL.data') then - where (var_data == 0.0_r4) + where (var_data == binary_fill) var_data = FVAL elsewhere var_data = log10(var_data) endwhere else ! Make sure the tracer concentration is positive - where(var_data < 0.0_r4) var_data = low_conc + where(var_data < binary_fill) var_data = low_conc if (log_transform) then where (var_data == 0.0_r4) @@ -735,7 +737,7 @@ subroutine from_mit_to_netcdf_tracer_2d(mitfile, ncid, varid) var_data = log(var_data) endwhere else - where (var_data == 0.0_r4) var_data = FVAL + where (var_data == binary_fill) var_data = FVAL endif endif @@ -770,8 +772,7 @@ subroutine from_netcdf_to_mit_2d(ncid, name) where (var == local_fval) var = 0.0_r4 endif - - +iunit = get_unit() open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & access='DIRECT', recl=recl, convert='BIG_ENDIAN') write(iunit,rec=1)var @@ -801,8 +802,9 @@ subroutine from_netcdf_to_mit_3d(ncid, name) endif call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) -where (var == local_fval) var = 0.0_r4 +where (var == local_fval) var = binary_fill +iunit = get_unit() open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & access='DIRECT', recl=recl, convert='BIG_ENDIAN') write(iunit,rec=1)var @@ -835,14 +837,15 @@ subroutine from_netcdf_to_mit_tracer(ncid, name) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) if (log_transform) then where (var == local_fval) - var = 0.0_r4 + var = binary_fill elsewhere var = exp(var) endwhere else - where (var == local_fval) var = 0.0_r4 + where (var == local_fval) var = binary_fill endif +iunit = get_unit() open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & access='DIRECT', recl=recl, convert='BIG_ENDIAN') write(iunit,rec=1)var @@ -1011,8 +1014,8 @@ subroutine read_compressed_2d(ncid, varid, var) integer :: n ! loop variable integer :: i,j ! x,y -! initialize var to 0 -var(:,:) = 0.0_r4 +! initialize var to binary file fill value +var(:,:) = binary_fill call check(nf90_get_var(ncid,varid,comp_var)) @@ -1034,8 +1037,8 @@ subroutine read_compressed_3d(ncid, varid, var) integer :: n ! loop variable integer :: i,j,k ! x,y,k -! initialize var to 0 -var(:,:,:) = 0.0_r4 +! initialize var to binary file fill value +var(:,:,:) = binary_fill call check(nf90_get_var(ncid,varid,comp_var)) From 6fbbdf0658f50acd7403377f48fd7898e55f8fe7 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 1 Sep 2022 14:16:13 -0600 Subject: [PATCH 024/124] somthing funky with ETA --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 33 ++++++++++++----------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index fe6a2d4684..f9113d599d 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -9,7 +9,7 @@ module trans_mitdart_mod use utilities_mod, only: initialize_utilities, register_module, & get_unit, find_namelist_in_file, file_exist, & check_namelist_read -use netcdf_utilities_mod, only : nc_get_variable +use netcdf_utilities_mod, only : nc_get_variable, nc_get_dimension_size use netcdf implicit none @@ -414,9 +414,9 @@ subroutine mit2dart() call check(nf90_put_var(ncid, YGcompVarID, YGcomp )) call check(nf90_put_var(ncid, YCcompVarID, YCcomp )) call check(nf90_put_var(ncid, ZCcompVarID, ZCcomp )) - call check(nf90_put_var(ncid, ZCcompVarID, Xcomp_ind )) - call check(nf90_put_var(ncid, ZCcompVarID, Ycomp_ind )) - call check(nf90_put_var(ncid, ZCcompVarID, Zcomp_ind )) + call check(nf90_put_var(ncid, XindID, Xcomp_ind )) + call check(nf90_put_var(ncid, YindID, Ycomp_ind )) + call check(nf90_put_var(ncid, ZindID, Zcomp_ind )) endif ! Fill the netcdf variables @@ -455,6 +455,8 @@ subroutine dart2mit() call check(nf90_open("INPUT.nc",NF90_NOWRITE,ncid)) if (compress) then + ncomp3 = nc_get_dimension_size(ncid,'comp3d') + ncomp2 = nc_get_dimension_size(ncid,'comp2d') allocate(Xcomp_ind(ncomp3)) allocate(Ycomp_ind(ncomp3)) allocate(Zcomp_ind(ncomp3)) @@ -802,6 +804,7 @@ subroutine from_netcdf_to_mit_3d(ncid, name) endif call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) + where (var == local_fval) var = binary_fill iunit = get_unit() @@ -856,9 +859,9 @@ end subroutine from_netcdf_to_mit_tracer !------------------------------------------------------------------ ! Assumes all 3D variables are masked in the ! same location -function get_compressed_size_3d() result(ncomp3) +function get_compressed_size_3d() result(n3) -integer :: ncomp3 +integer :: n3 integer :: iunit integer :: recl ! datasize*4 real(r4) :: var3d(NX,NY,NZ) @@ -870,14 +873,14 @@ function get_compressed_size_3d() result(ncomp3) read(iunit,rec=1) var3d close(iunit) -ncomp3 = 0 +n3 = 0 ! Get compressed size do i=1,NX do j=1,NY do k=1,NZ if (var3d(i,j,k) /= binary_fill) then !HK also NaN? - ncomp3 = ncomp3 + 1 + n3 = n3 + 1 endif enddo enddo @@ -888,9 +891,9 @@ end function get_compressed_size_3d !------------------------------------------------------------------ ! Assumes all 3D variables are masked in the ! same location -function get_compressed_size_2d() result(ncomp2) +function get_compressed_size_2d() result(n2) -integer :: ncomp2 +integer :: n2 integer :: iunit integer :: recl ! datasize*4 real(r4) :: var2d(NX,NY) @@ -902,13 +905,13 @@ function get_compressed_size_2d() result(ncomp2) read(iunit,rec=1) var2d close(iunit) -ncomp2 = 0 +n2 = 0 ! Get compressed size do i=1,NX do j=1,NY if (var2d(i,j) /= binary_fill) then !HK also NaN? - ncomp2 = ncomp2 + 1 + n2 = n2 + 1 endif enddo enddo @@ -967,7 +970,7 @@ subroutine write_compressed_2d(ncid, varid, var_data) n = 1 do i = 1, NX do j = 1, NY - if (var_data(i,j) /= binary_fill) then !HK check for nans? + if (var_data(i,j) /= FVAL) then comp_var(n) = var_data(i,j) n = n + 1 endif @@ -992,7 +995,7 @@ subroutine write_compressed_3d(ncid, varid, var_data) do i = 1, NX do j = 1, NY do k = 1 , NZ - if (var_data(i,j,k) /= binary_fill) then !HK check for nans? + if (var_data(i,j,k) /= FVAL) then comp_var(n) = var_data(i,j,k) n = n + 1 endif @@ -1042,7 +1045,7 @@ subroutine read_compressed_3d(ncid, varid, var) call check(nf90_get_var(ncid,varid,comp_var)) -do n = 1, ncomp2 +do n = 1, ncomp3 i = Xcomp_ind(n) j = Ycomp_ind(n) k = Zcomp_ind(n) From a7d60dbec9d6b7d77bc1e65973cf6f6c8a77c965 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 1 Sep 2022 15:42:39 -0600 Subject: [PATCH 025/124] bug-fix: 2D ETA variable is th k=1 slice --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index f9113d599d..db8f9f2580 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -1015,17 +1015,23 @@ subroutine read_compressed_2d(ncid, varid, var) real(r4) :: comp_var(ncomp2) integer :: n ! loop variable -integer :: i,j ! x,y +integer :: i,j,k ! x,y,z +integer :: c ! initialize var to binary file fill value var(:,:) = binary_fill +c = 1 call check(nf90_get_var(ncid,varid,comp_var)) -do n = 1, ncomp2 +do n = 1, ncomp3 i = Xcomp_ind(n) j = Ycomp_ind(n) - var(i,j) = comp_var(n) + k = Zcomp_ind(n) + if (k == 1 ) then + var(i,j) = comp_var(c) + c = c + 1 + endif enddo end subroutine read_compressed_2d From 0c2c781ebff191ae08ad703d122cb7c2cedfb238 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 2 Sep 2022 09:45:53 -0600 Subject: [PATCH 026/124] revert assim_tools_mod to main the caching was fixed in #368 --- .../modules/assimilation/assim_tools_mod.f90 | 26 ------------------- 1 file changed, 26 deletions(-) diff --git a/assimilation_code/modules/assimilation/assim_tools_mod.f90 b/assimilation_code/modules/assimilation/assim_tools_mod.f90 index b57a64e3a9..99b636c753 100644 --- a/assimilation_code/modules/assimilation/assim_tools_mod.f90 +++ b/assimilation_code/modules/assimilation/assim_tools_mod.f90 @@ -369,7 +369,6 @@ subroutine filter_assim(ens_handle, obs_ens_handle, obs_seq, keys, & logical :: local_varying_ss_inflate logical :: local_ss_inflate logical :: local_obs_inflate -logical :: close_obs_caching_init ! allocate rather than dump all this on the stack allocate(close_obs_dist( obs_ens_handle%my_num_vars), & @@ -390,9 +389,6 @@ subroutine filter_assim(ens_handle, obs_ens_handle, obs_seq, keys, & ! Initialize assim_tools_module if needed if (.not. module_initialized) call assim_tools_init() -!EL Record down the initial value of close_obs_caching after initialization -close_obs_caching_init = close_obs_caching - !HK make window for mpi one-sided communication ! used for vertical conversion in get_close_obs ! Need to give create_mean_window the mean copy @@ -777,16 +773,7 @@ subroutine filter_assim(ens_handle, obs_ens_handle, obs_seq, keys, & ! diagnostics for stats on saving calls by remembering obs at the same location. ! change .true. to .false. in the line below to remove the output completely. - -! EL: -if (close_obs_caching_init) then - if ( ( num_close_obs_cached == 0 .or. num_close_states_cached == 0 ) .and. (do_output()) ) then - print *, "No observations or states was cached. Setting close_obs_caching = .false. may significantly improve the runtime" - endif -endif - if (close_obs_caching) then - if (num_close_obs_cached > 0 .and. do_output()) then print *, "Total number of calls made to get_close_obs for obs/states: ", & num_close_obs_calls_made + num_close_states_calls_made @@ -2628,7 +2615,6 @@ subroutine get_close_state_cached(gc_state, base_obs_loc, base_obs_type, & type(location_type), intent(inout) :: last_base_states_loc integer, intent(inout) :: last_num_close_states integer, intent(inout) :: num_close_states_cached, num_close_states_calls_made -integer :: my_num_state ! Number of either states or observations ! This logic could be arranged to make code less redundant if (.not. close_obs_caching) then @@ -2648,20 +2634,8 @@ subroutine get_close_state_cached(gc_state, base_obs_loc, base_obs_type, & last_num_close_states = num_close_states num_close_states_calls_made = num_close_states_calls_made +1 endif -! EL Check if too few states are cached. If so, turn off close_obs_caching for the user. - if ( num_close_states_calls_made > my_num_state / 10.0_r8 ) then - if ( num_close_states_cached / num_close_states_calls_made <= 0.05_r8 ) then - if (do_output()) then - print *, "Too few states are cached, turning off close_obs_caching" - endif - close_obs_caching = .false. - endif - endif endif -! Test to set the close_obs_caching to false after the first run. -! close_obs_caching = .false. - end subroutine get_close_state_cached !-------------------------------------------------------------------- From 80e22dcc149b7cdd68e45510843873cb14d2ec5b Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 2 Sep 2022 15:24:35 -0600 Subject: [PATCH 027/124] move initializing to fill outside read_compressed --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 25 +++++++++++++---------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index db8f9f2580..6528d82020 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -766,11 +766,14 @@ subroutine from_netcdf_to_mit_2d(ncid, name) recl = Nx*Ny*4 call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) +! initialize var to netcdf fill value +var(:,:) = local_fval + if (compress) then call read_compressed(ncid, varid, var) else call check(nf90_get_var(ncid,varid,var)) - call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) where (var == local_fval) var = 0.0_r4 endif @@ -797,14 +800,16 @@ subroutine from_netcdf_to_mit_3d(ncid, name) recl = Nx*Ny*Nz*4 call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) +! initialize var to netcdf fill value +var(:,:,:) = local_fval + if (compress) then call read_compressed(ncid, varid, var) else call check(nf90_get_var(ncid,varid,var)) endif -call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) - where (var == local_fval) var = binary_fill iunit = get_unit() @@ -831,13 +836,16 @@ subroutine from_netcdf_to_mit_tracer(ncid, name) recl = Nx*Ny*Nz*4 call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) +! initialize var to netcdf fill value +var(:,:,:) = local_fval + if (compress) then call read_compressed(ncid, varid, var) else call check(nf90_get_var(ncid,varid,var)) endif -call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) if (log_transform) then where (var == local_fval) var = binary_fill @@ -1011,15 +1019,13 @@ end subroutine write_compressed_3d subroutine read_compressed_2d(ncid, varid, var) integer, intent(in) :: ncid, varid -real(r4), intent(out) :: var(NX,NY) +real(r4), intent(inout) :: var(NX,NY) real(r4) :: comp_var(ncomp2) integer :: n ! loop variable integer :: i,j,k ! x,y,z integer :: c -! initialize var to binary file fill value -var(:,:) = binary_fill c = 1 call check(nf90_get_var(ncid,varid,comp_var)) @@ -1040,15 +1046,12 @@ end subroutine read_compressed_2d subroutine read_compressed_3d(ncid, varid, var) integer, intent(in) :: ncid, varid -real(r4), intent(out) :: var(NX,NY,NZ) +real(r4), intent(inout) :: var(NX,NY,NZ) real(r4) :: comp_var(ncomp3) integer :: n ! loop variable integer :: i,j,k ! x,y,k -! initialize var to binary file fill value -var(:,:,:) = binary_fill - call check(nf90_get_var(ncid,varid,comp_var)) do n = 1, ncomp3 From 3d1746fcb55d082667617687c6dbdf5ed8c1e6c1 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 16 Sep 2022 16:03:46 -0600 Subject: [PATCH 028/124] bug fix: was not setting binary fill correctly for 2d recl Nx*Ny*Nz*4 variable - the 4 should just be a parameter --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 6528d82020..d9bce67510 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -733,7 +733,7 @@ subroutine from_mit_to_netcdf_tracer_2d(mitfile, ncid, varid) where(var_data < binary_fill) var_data = low_conc if (log_transform) then - where (var_data == 0.0_r4) + where (var_data == binary_fill) var_data = FVAL elsewhere var_data = log(var_data) @@ -774,9 +774,10 @@ subroutine from_netcdf_to_mit_2d(ncid, name) call read_compressed(ncid, varid, var) else call check(nf90_get_var(ncid,varid,var)) - where (var == local_fval) var = 0.0_r4 endif +where (var == local_fval) var = binary_fill + iunit = get_unit() open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & access='DIRECT', recl=recl, convert='BIG_ENDIAN') @@ -875,9 +876,11 @@ function get_compressed_size_3d() result(n3) real(r4) :: var3d(NX,NY,NZ) integer :: i,j,k +recl = Nx*Ny*Nz*4 + iunit = get_unit() open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=Nx*Ny*Nz, convert='BIG_ENDIAN') + access='DIRECT', recl=recl, convert='BIG_ENDIAN') read(iunit,rec=1) var3d close(iunit) @@ -907,9 +910,11 @@ function get_compressed_size_2d() result(n2) real(r4) :: var2d(NX,NY) integer :: i,j +recl = Nx*Ny*4 + iunit = get_unit() open(iunit, file='ETA.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=Nx*Ny*4, convert='BIG_ENDIAN') + access='DIRECT', recl=recl, convert='BIG_ENDIAN') read(iunit,rec=1) var2d close(iunit) @@ -936,7 +941,7 @@ subroutine fill_compressed_coords() iunit = get_unit() open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=Nx*Ny*Nz, convert='BIG_ENDIAN') + access='DIRECT', recl=Nx*Ny*Nz*4, convert='BIG_ENDIAN') read(iunit,rec=1) var3d close(iunit) From 9951fd84d6511ac1e15a61aadc4830b04d1893b0 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 19 Sep 2022 09:07:48 -0600 Subject: [PATCH 029/124] removed dart_nc_reduce/expand as these functions are now part of mit_to_dart/dart_to_mit --- models/MITgcm_ocean/dart_nc_expand.f90 | 260 ---------------------- models/MITgcm_ocean/dart_nc_reduce.f90 | 289 ------------------------- models/MITgcm_ocean/work/quickbuild.sh | 2 - 3 files changed, 551 deletions(-) delete mode 100644 models/MITgcm_ocean/dart_nc_expand.f90 delete mode 100644 models/MITgcm_ocean/dart_nc_reduce.f90 diff --git a/models/MITgcm_ocean/dart_nc_expand.f90 b/models/MITgcm_ocean/dart_nc_expand.f90 deleted file mode 100644 index 5f5301aae8..0000000000 --- a/models/MITgcm_ocean/dart_nc_expand.f90 +++ /dev/null @@ -1,260 +0,0 @@ -program nc_reduce - -use netcdf_utilities_mod, only : nc_get_variable, nc_define_dimension, nc_define_real_variable, & - nc_put_variable, nc_check, nc_open_file_readonly, & - nc_open_file_readwrite, nc_close_file, nc_create_file, & - nc_get_variable_size, nc_define_double_variable - -use types_mod, only : r4, r8 - -use utilities_mod, only : initialize_utilities, finalize_utilities - -use netcdf - -implicit none - -integer :: ncid, new_ncid, ncid_comp -character(len=NF90_MAX_NAME) :: new_name - - -integer, parameter :: ndim_3d = 3 -integer, parameter :: ndim_2d = 2 -integer, parameter :: hgrid = 500 -integer, parameter :: vgrid = 50 - -real(r4), allocatable :: psal(:,:,:), ptmp(:,:,:), uvel(:,:,:), vvel(:,:,:) -real(r4), allocatable :: no3(:,:,:), po4(:,:,:), o2(:,:,:), phy(:,:,:), alk(:,:,:) -real(r4), allocatable :: dic(:,:,:), dop(:,:,:), don(:,:,:), fet(:,:,:) -real(r4), allocatable :: eta(:,:), chl(:,:) -real(r4), allocatable :: psal_f(:), ptmp_f(:), uvel_f(:), vvel_f(:) -real(r4), allocatable :: no3_f(:), po4_f(:), o2_f(:), phy_f(:), alk_f(:) -real(r4), allocatable :: dic_f(:), dop_f(:), don_f(:), fet_f(:) -real(r4), allocatable :: eta_f(:), chl_f(:) - -! Dimensions -real(r4) :: xg(hgrid), xc(hgrid), yg(hgrid), yc(hgrid) -real(r8) :: zc(vgrid) ! ZC is double -integer :: i,j,k ! loop counter -integer :: ct_3d, ct_2d, dimarr_3d_ct, dimarr_2d_ct -integer :: psalsize(ndim_3d), ptmpsize(ndim_3d), uvelsize(ndim_3d) -integer :: vvelsize(ndim_3d), no3size(ndim_3d), po4size(ndim_3d) -integer :: o2size(ndim_3d), physize(ndim_3d), alksize(ndim_3d) -integer :: dicsize(ndim_3d), dopsize(ndim_3d), donsize(ndim_3d), fetsize(ndim_3d) -integer :: etasize(ndim_2d), chlsize(ndim_2d) - - -call initialize_utilities('dart_nc_expand') - -ncid = nc_open_file_readonly('mem01.nc') - -call nc_get_variable(ncid, 'XC', xc) -call nc_get_variable(ncid, 'XG', xg) -call nc_get_variable(ncid, 'YC', yc) -call nc_get_variable(ncid, 'YG', yg) -call nc_get_variable(ncid, 'ZC', zc) - - -! Get the size, allocate arrays, and assign values. -call nc_get_variable_size(ncid, 'PSAL', psalsize) -call nc_get_variable_size(ncid, 'PTMP', ptmpsize) -call nc_get_variable_size(ncid, 'UVEL', uvelsize) -call nc_get_variable_size(ncid, 'VVEL', vvelsize) -call nc_get_variable_size(ncid, 'NO3', no3size) -call nc_get_variable_size(ncid, 'PO4', po4size) -call nc_get_variable_size(ncid, 'O2', o2size) -call nc_get_variable_size(ncid, 'PHY', physize) -call nc_get_variable_size(ncid, 'ALK', alksize) -call nc_get_variable_size(ncid, 'DIC', dicsize) -call nc_get_variable_size(ncid, 'DOP', dopsize) -call nc_get_variable_size(ncid, 'DON', donsize) -call nc_get_variable_size(ncid, 'FET', fetsize) -call nc_get_variable_size(ncid, 'ETA', etasize) -call nc_get_variable_size(ncid, 'CHL', chlsize) - -allocate(psal(psalsize(1), psalsize(2), psalsize(3))) -call nc_get_variable(ncid, 'PSAL', psal) - -allocate(ptmp(ptmpsize(1), ptmpsize(2), ptmpsize(3))) -call nc_get_variable(ncid, 'PTMP', ptmp) - -allocate(uvel(uvelsize(1), uvelsize(2), uvelsize(3))) -call nc_get_variable(ncid, 'UVEL', uvel) - -allocate(vvel(vvelsize(1), vvelsize(2), vvelsize(3))) -call nc_get_variable(ncid, 'VVEL', vvel) - -allocate(no3(no3size(1), no3size(2), no3size(3))) -call nc_get_variable(ncid, 'NO3', no3) - -allocate(po4(po4size(1), po4size(2), po4size(3))) -call nc_get_variable(ncid, 'PO4', po4) - -allocate(o2(o2size(1), o2size(2), o2size(3))) -call nc_get_variable(ncid, 'O2', o2) - -allocate(phy(physize(1), physize(2), physize(3))) -call nc_get_variable(ncid, 'PHY', phy) - -allocate(alk(alksize(1), alksize(2), alksize(3))) -call nc_get_variable(ncid, 'ALK', alk) - -allocate(dic(dicsize(1), dicsize(2), dicsize(3))) -call nc_get_variable(ncid, 'DIC', dic) - -allocate(dop(dopsize(1), dopsize(2), dopsize(3))) -call nc_get_variable(ncid, 'DOP', dop) - -allocate(don(donsize(1), donsize(2), donsize(3))) -call nc_get_variable(ncid, 'DON', don) - -allocate(fet(fetsize(1), fetsize(2), fetsize(3))) -call nc_get_variable(ncid, 'FET', fet) - -allocate(eta(etasize(1), etasize(2))) -call nc_get_variable(ncid, 'ETA', eta) - -allocate(chl(chlsize(1), chlsize(2))) -call nc_get_variable(ncid, 'CHL', chl) - -! counts are from the compressed file -ncid_comp = nc_open_file_readonly('output_mem01.nc') -call nc_get_variable_size(ncid_comp, 'PSAL', ct_3d) -call nc_get_variable_size(ncid_comp, 'CHL', ct_2d) - -allocate(psal_f(ct_3d)) -allocate(ptmp_f(ct_3d)) -allocate(uvel_f(ct_3d)) -allocate(vvel_f(ct_3d)) -allocate(no3_f(ct_3d)) -allocate(po4_f(ct_3d)) -allocate(o2_f(ct_3d)) -allocate(phy_f(ct_3d)) -allocate(alk_f(ct_3d)) -allocate(dic_f(ct_3d)) -allocate(dop_f(ct_3d)) -allocate(don_f(ct_3d)) -allocate(fet_f(ct_3d)) -allocate(chl_f(ct_2d)) -allocate(eta_f(ct_2d)) - -call nc_get_variable(ncid_comp, 'PSAL', psal_f) -call nc_get_variable(ncid_comp, 'PTMP', ptmp_f) -call nc_get_variable(ncid_comp, 'UVEL', uvel_f) -call nc_get_variable(ncid_comp, 'VVEL', vvel_f) -call nc_get_variable(ncid_comp, 'NO3', no3_f) -call nc_get_variable(ncid_comp, 'PO4', po4_f) -call nc_get_variable(ncid_comp, 'O2', o2_f) -call nc_get_variable(ncid_comp, 'PHY', phy_f) -call nc_get_variable(ncid_comp, 'ALK', alk_f) -call nc_get_variable(ncid_comp, 'DIC', dic_f) -call nc_get_variable(ncid_comp, 'DOP', dop_f) -call nc_get_variable(ncid_comp, 'DON', don_f) -call nc_get_variable(ncid_comp, 'FET', fet_f) -call nc_get_variable(ncid_comp, 'ETA', eta_f) -call nc_get_variable(ncid_comp, 'CHL', chl_f) - - -dimarr_3d_ct = 1 -dimarr_2d_ct = 1 - -do k=1,psalsize(3) - do i=1,psalsize(1) - do j=1,psalsize(2) - if (psal(i,j,k) /= -999.) then - psal(i,j,k) = psal_f(dimarr_3d_ct) - ptmp(i,j,k) = ptmp_f(dimarr_3d_ct) - uvel(i,j,k) = uvel_f(dimarr_3d_ct) - vvel(i,j,k) = vvel_f(dimarr_3d_ct) - no3(i,j,k) = no3_f(dimarr_3d_ct) - po4(i,j,k) = po4_f(dimarr_3d_ct) - o2(i,j,k) = o2_f(dimarr_3d_ct) - phy(i,j,k) = phy_f(dimarr_3d_ct) - alk(i,j,k) = alk_f(dimarr_3d_ct) - dic(i,j,k) = dic_f(dimarr_3d_ct) - dop(i,j,k) = dop_f(dimarr_3d_ct) - don(i,j,k) = don_f(dimarr_3d_ct) - fet(i,j,k) = fet_f(dimarr_3d_ct) - dimarr_3d_ct = dimarr_3d_ct + 1 - endif - enddo - enddo -enddo - -do i=1,chlsize(1) - do j=1,chlsize(2) - if (chl(i,j) /= -999.) then - - eta(i,j) = eta_f(dimarr_2d_ct) - chl(i,j) = chl_f(dimarr_2d_ct) - - dimarr_2d_ct = dimarr_2d_ct + 1 - endif - enddo -enddo - - -! Start creating the new netcdf and define the new 1-d dimension. -new_name = 'unsquished_mem01.nc' -new_ncid = nc_create_file(new_name, 'unsquished file') -call nc_define_dimension(new_ncid, 'XG', hgrid) -call nc_define_dimension(new_ncid, 'XC', hgrid) -call nc_define_dimension(new_ncid, 'YG', hgrid) -call nc_define_dimension(new_ncid, 'YC', hgrid) -call nc_define_dimension(new_ncid, 'ZC', vgrid) - -! Put all the (new) variables in -call nc_define_real_variable(new_ncid, 'PSAL', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'PTMP', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'UVEL', (/'XG','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'VVEL', (/'XC','YG','ZC'/)) -call nc_define_real_variable(new_ncid, 'ETA', (/'XC','YC'/)) -call nc_define_real_variable(new_ncid, 'NO3', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'PO4', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'O2', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'PHY', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'ALK', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'DIC', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'DOP', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'DON', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'FET', (/'XC','YC','ZC'/)) -call nc_define_real_variable(new_ncid, 'CHL', (/'XC','YC'/)) - - -call nc_define_real_variable(new_ncid, 'XC','XC') -call nc_define_real_variable(new_ncid, 'XG','XG') -call nc_define_real_variable(new_ncid, 'YC','YC') -call nc_define_real_variable(new_ncid, 'YG','YG') -call nc_define_double_variable(new_ncid, 'ZC','ZC') - -! Close the file -call nc_close_file(new_ncid) - -! Write the information -new_ncid = nc_open_file_readwrite(new_name) -call nc_put_variable(new_ncid, 'PSAL', psal) -call nc_put_variable(new_ncid, 'PTMP', ptmp) -call nc_put_variable(new_ncid, 'UVEL', uvel) -call nc_put_variable(new_ncid, 'VVEL', vvel) -call nc_put_variable(new_ncid, 'ETA', eta) -call nc_put_variable(new_ncid, 'NO3', no3) -call nc_put_variable(new_ncid, 'PO4', po4) -call nc_put_variable(new_ncid, 'O2', o2) -call nc_put_variable(new_ncid, 'PHY', phy) -call nc_put_variable(new_ncid, 'ALK', alk) -call nc_put_variable(new_ncid, 'DIC', dic) -call nc_put_variable(new_ncid, 'DOP', dop) -call nc_put_variable(new_ncid, 'DON', don) -call nc_put_variable(new_ncid, 'FET', fet) -call nc_put_variable(new_ncid, 'CHL', chl) - -call nc_put_variable(new_ncid, 'XC', xc) -call nc_put_variable(new_ncid, 'XG', xg) -call nc_put_variable(new_ncid, 'YC', yc) -call nc_put_variable(new_ncid, 'YG', yg) -call nc_put_variable(new_ncid, 'ZC', zc) - -call nc_close_file(new_ncid) - -call finalize_utilities('dart_nc_reduce') - -end program nc_reduce diff --git a/models/MITgcm_ocean/dart_nc_reduce.f90 b/models/MITgcm_ocean/dart_nc_reduce.f90 deleted file mode 100644 index 06bff0faa3..0000000000 --- a/models/MITgcm_ocean/dart_nc_reduce.f90 +++ /dev/null @@ -1,289 +0,0 @@ -program nc_reduce - -use netcdf_utilities_mod, only : nc_get_variable, nc_define_dimension, nc_define_real_variable, & - nc_put_variable, nc_check, nc_open_file_readonly, & - nc_open_file_readwrite, nc_close_file, nc_create_file, & - nc_get_variable_size, nc_define_double_variable - -use types_mod, only : r4, r8 - -use utilities_mod, only : initialize_utilities, finalize_utilities - -use netcdf - -implicit none - -integer :: ncid, ret, new_ncid -character(len=NF90_MAX_NAME) :: new_name - - -integer, parameter :: ndim_3d=3 -integer, parameter :: ndim_2d=2 -real(r4), allocatable :: psal(:,:,:), ptmp(:,:,:), uvel(:,:,:), vvel(:,:,:) -real(r4), allocatable :: no3(:,:,:), po4(:,:,:), o2(:,:,:), phy(:,:,:), alk(:,:,:) -real(r4), allocatable :: dic(:,:,:), dop(:,:,:), don(:,:,:), fet(:,:,:) -real(r4), allocatable :: eta(:,:), chl(:,:) -real(r4), allocatable :: psal_f(:), ptmp_f(:), uvel_f(:), vvel_f(:) -real(r4), allocatable :: no3_f(:), po4_f(:), o2_f(:), phy_f(:), alk_f(:) -real(r4), allocatable :: dic_f(:), dop_f(:), don_f(:), fet_f(:) -real(r4), allocatable :: eta_f(:), chl_f(:) - -! Dimensions -!real(r4) :: xg(2000), xc(2000), yg(2000), yc(2000) -real(r4) :: xg(500), xc(500), yg(500), yc(500) -real(r8) :: zc(50) -integer :: i,j,k ! loop counter -integer :: ct_3d, ct_2d, dimarr_3d_ct, dimarr_2d_ct -integer :: psalsize(ndim_3d), ptmpsize(ndim_3d), uvelsize(ndim_3d) -integer :: vvelsize(ndim_3d), no3size(ndim_3d), po4size(ndim_3d) -integer :: o2size(ndim_3d), physize(ndim_3d), alksize(ndim_3d) -integer :: dicsize(ndim_3d), dopsize(ndim_3d), donsize(ndim_3d), fetsize(ndim_3d) -integer :: etasize(ndim_2d), chlsize(ndim_2d) -real(r4), allocatable :: dimarr_3d(:,:) -real(r4), allocatable :: dimarr_2d(:,:) -integer, allocatable :: dimind_3d(:,:) -integer, allocatable :: dimind_2d(:,:) - - -call initialize_utilities('dart_nc_reduce') - -ncid = nc_open_file_readonly('mem01.nc') - -call nc_get_variable(ncid, 'XC', xc) -call nc_get_variable(ncid, 'XG', xg) -call nc_get_variable(ncid, 'YC', yc) -call nc_get_variable(ncid, 'YG', yg) -call nc_get_variable(ncid, 'ZC', zc) - -write(*,*) 'xc' -write(*,*) xc(3) - -write(*,*) 'xg' -write(*,*) xg(3) - -write(*,*) 'yc' -write(*,*) yc(3) - -write(*,*) 'yg' -write(*,*) yg(3) - - -! Get the size, allocate arrays, and assign values. -call nc_get_variable_size(ncid, 'PSAL', psalsize) -call nc_get_variable_size(ncid, 'PTMP', ptmpsize) -call nc_get_variable_size(ncid, 'UVEL', uvelsize) -call nc_get_variable_size(ncid, 'VVEL', vvelsize) -call nc_get_variable_size(ncid, 'NO3', no3size) -call nc_get_variable_size(ncid, 'PO4', po4size) -call nc_get_variable_size(ncid, 'O2', o2size) -call nc_get_variable_size(ncid, 'PHY', physize) -call nc_get_variable_size(ncid, 'ALK', alksize) -call nc_get_variable_size(ncid, 'DIC', dicsize) -call nc_get_variable_size(ncid, 'DOP', dopsize) -call nc_get_variable_size(ncid, 'DON', donsize) -call nc_get_variable_size(ncid, 'FET', fetsize) -call nc_get_variable_size(ncid, 'ETA', etasize) -call nc_get_variable_size(ncid, 'CHL', chlsize) - -allocate(psal(psalsize(1), psalsize(2), psalsize(3))) -call nc_get_variable(ncid, 'PSAL', psal) - -allocate(ptmp(ptmpsize(1), ptmpsize(2), ptmpsize(3))) -call nc_get_variable(ncid, 'PTMP', ptmp) - -allocate(uvel(uvelsize(1), uvelsize(2), uvelsize(3))) -call nc_get_variable(ncid, 'UVEL', uvel) - -allocate(vvel(vvelsize(1), vvelsize(2), vvelsize(3))) -call nc_get_variable(ncid, 'VVEL', vvel) - -allocate(no3(no3size(1), no3size(2), no3size(3))) -call nc_get_variable(ncid, 'NO3', no3) - -allocate(po4(po4size(1), po4size(2), po4size(3))) -call nc_get_variable(ncid, 'PO4', po4) - -allocate(o2(o2size(1), o2size(2), o2size(3))) -call nc_get_variable(ncid, 'O2', o2) - -allocate(phy(physize(1), physize(2), physize(3))) -call nc_get_variable(ncid, 'PHY', phy) - -allocate(alk(alksize(1), alksize(2), alksize(3))) -call nc_get_variable(ncid, 'ALK', alk) - -allocate(dic(dicsize(1), dicsize(2), dicsize(3))) -call nc_get_variable(ncid, 'DIC', dic) - -allocate(dop(dopsize(1), dopsize(2), dopsize(3))) -call nc_get_variable(ncid, 'DOP', dop) - -allocate(don(donsize(1), donsize(2), donsize(3))) -call nc_get_variable(ncid, 'DON', don) - -allocate(fet(fetsize(1), fetsize(2), fetsize(3))) -call nc_get_variable(ncid, 'FET', fet) - -allocate(eta(etasize(1), etasize(2))) -call nc_get_variable(ncid, 'ETA', eta) - -allocate(chl(chlsize(1), chlsize(2))) -call nc_get_variable(ncid, 'CHL', chl) - -! ul = size(pack(psal, psal /= -999.0)) -! write(*,*) psalsize -! write(*,*) o2size -! write(*,*) etasize - -ct_3d = 0 -ct_2d = 0 -! -! -do i=1,psalsize(1) - do j=1,psalsize(2) - if (chl(i,j) /= -999.) then - ct_2d = ct_2d + 1 - endif - do k=1,psalsize(3) - if (psal(i,j,k) /= -999.) then - ct_3d = ct_3d + 1 - endif - enddo - enddo -enddo - -allocate(dimarr_3d(ct_3d, 3)) -allocate(dimarr_2d(ct_2d, 2)) -allocate(dimind_3d(ct_3d, 3)) -allocate(dimind_2d(ct_2d, 2)) - -allocate(psal_f(ct_3d)) -allocate(ptmp_f(ct_3d)) -allocate(uvel_f(ct_3d)) -allocate(vvel_f(ct_3d)) -allocate(no3_f(ct_3d)) -allocate(po4_f(ct_3d)) -allocate(o2_f(ct_3d)) -allocate(phy_f(ct_3d)) -allocate(alk_f(ct_3d)) -allocate(dic_f(ct_3d)) -allocate(dop_f(ct_3d)) -allocate(don_f(ct_3d)) -allocate(fet_f(ct_3d)) -allocate(chl_f(ct_2d)) -allocate(eta_f(ct_2d)) - - -dimarr_3d_ct = 1 -dimarr_2d_ct = 1 - -! > EL change 06/23: make the depth the outer loop for this. This will make sure the 2d components -! > are the first terms of the 3d components. -do k=1,psalsize(3) - do i=1,psalsize(1) - do j=1,psalsize(2) - if (psal(i,j,k) /= -999.) then - dimarr_3d(dimarr_3d_ct, 1) = xc(i) - dimarr_3d(dimarr_3d_ct, 2) = yc(j) - dimarr_3d(dimarr_3d_ct, 3) = zc(k) - dimind_3d(dimarr_3d_ct, 1) = i - dimind_3d(dimarr_3d_ct, 2) = j - dimind_3d(dimarr_3d_ct, 3) = k - - psal_f(dimarr_3d_ct) = psal(i,j,k) - ptmp_f(dimarr_3d_ct) = ptmp(i,j,k) - uvel_f(dimarr_3d_ct) = uvel(i,j,k) - vvel_f(dimarr_3d_ct) = vvel(i,j,k) - no3_f(dimarr_3d_ct) = no3(i,j,k) - po4_f(dimarr_3d_ct) = po4(i,j,k) - o2_f(dimarr_3d_ct) = o2(i,j,k) - phy_f(dimarr_3d_ct) = phy(i,j,k) - alk_f(dimarr_3d_ct) = alk(i,j,k) - dic_f(dimarr_3d_ct) = dic(i,j,k) - dop_f(dimarr_3d_ct) = dop(i,j,k) - don_f(dimarr_3d_ct) = don(i,j,k) - fet_f(dimarr_3d_ct) = fet(i,j,k) - dimarr_3d_ct = dimarr_3d_ct + 1 - endif - enddo - enddo -enddo - -do i=1,chlsize(1) - do j=1,chlsize(2) - if (chl(i,j) /= -999.) then - dimarr_2d(dimarr_2d_ct, 1) = xc(i) - dimarr_2d(dimarr_2d_ct, 2) = yc(j) - - dimind_2d(dimarr_2d_ct, 1) = i - dimind_2d(dimarr_2d_ct, 2) = j - eta_f(dimarr_2d_ct) = eta(i,j) - chl_f(dimarr_2d_ct) = chl(i,j) - - dimarr_2d_ct = dimarr_2d_ct + 1 - endif - enddo -enddo - - -! Start creating the new netcdf and define the new 1-d dimension. -new_name = 'output_mem01.nc' -new_ncid = nc_create_file(new_name, 'squished file') -print*, 'ct_3d', ct_3d, 'ct_2d', ct_2d -call nc_define_dimension(new_ncid, 'useful_info_3d', ct_3d) -call nc_define_dimension(new_ncid, 'useful_info_2d', ct_2d) - -! Put all the (new) variables in -call nc_define_real_variable(new_ncid, 'PSAL', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'PTMP', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'UVEL', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'VVEL', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'ETA', 'useful_info_2d') -call nc_define_real_variable(new_ncid, 'NO3', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'PO4', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'O2', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'PHY', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'ALK', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'DIC', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'DOP', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'DON', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'FET', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'CHL', 'useful_info_2d') -call nc_define_real_variable(new_ncid, 'XC_3D', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'XC_2D', 'useful_info_2d') -call nc_define_real_variable(new_ncid, 'YC_3D', 'useful_info_3d') -call nc_define_real_variable(new_ncid, 'YC_2D', 'useful_info_2d') -call nc_define_double_variable(new_ncid, 'ZC_3D', 'useful_info_3d') - -! Close the file -call nc_close_file(new_ncid) - -! Write the information -new_ncid = nc_open_file_readwrite(new_name) -call nc_put_variable(new_ncid, 'PSAL', psal_f) -call nc_put_variable(new_ncid, 'PTMP', ptmp_f) -call nc_put_variable(new_ncid, 'UVEL', uvel_f) -call nc_put_variable(new_ncid, 'VVEL', vvel_f) -call nc_put_variable(new_ncid, 'ETA', eta_f) -call nc_put_variable(new_ncid, 'NO3', no3_f) -call nc_put_variable(new_ncid, 'PO4', po4_f) -call nc_put_variable(new_ncid, 'O2', o2_f) -call nc_put_variable(new_ncid, 'PHY', phy_f) -call nc_put_variable(new_ncid, 'ALK', alk_f) -call nc_put_variable(new_ncid, 'DIC', dic_f) -call nc_put_variable(new_ncid, 'DOP', dop_f) -call nc_put_variable(new_ncid, 'DON', don_f) -call nc_put_variable(new_ncid, 'FET', fet_f) -call nc_put_variable(new_ncid, 'CHL', chl_f) -call nc_put_variable(new_ncid, 'XC_3D', dimarr_3d(:, 1)) -call nc_put_variable(new_ncid, 'YC_3D', dimarr_3d(:, 2)) -call nc_put_variable(new_ncid, 'ZC_3D', dimarr_3d(:, 3)) -call nc_put_variable(new_ncid, 'XC_2D', dimarr_2d(:, 1)) -call nc_put_variable(new_ncid, 'YC_2D', dimarr_2d(:, 2)) - - -call nc_close_file(new_ncid) - -call finalize_utilities('dart_nc_reduce') - -end program nc_reduce diff --git a/models/MITgcm_ocean/work/quickbuild.sh b/models/MITgcm_ocean/work/quickbuild.sh index 7d48b2f058..80731cfd82 100755 --- a/models/MITgcm_ocean/work/quickbuild.sh +++ b/models/MITgcm_ocean/work/quickbuild.sh @@ -34,8 +34,6 @@ model_serial_programs=( dart_to_mit mit_to_dart create_ocean_obs -dart_nc_reduce -dart_nc_expand ) arguments "$@" From 720f76392bb637960c064975e2a58a0bef98c479 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 19 Sep 2022 09:13:54 -0600 Subject: [PATCH 030/124] revert mpas input.nml to main Ed was profiling mpas as part of siparcs, not relevant for this branch --- models/mpas_atm/work/input.nml | 21 ++------------------- 1 file changed, 2 insertions(+), 19 deletions(-) diff --git a/models/mpas_atm/work/input.nml b/models/mpas_atm/work/input.nml index c1f7403fac..c4f4d0c20a 100644 --- a/models/mpas_atm/work/input.nml +++ b/models/mpas_atm/work/input.nml @@ -237,22 +237,6 @@ write_nml = 'file' / -# &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_qty_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90' -# output_obs_qty_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90' -# obs_type_files = '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90', -# '../../../observations/forward_operators/obs_def_altimeter_mod.f90', -# '../../../observations/forward_operators/obs_def_gts_mod.f90', -# '../../../observations/forward_operators/obs_def_metar_mod.f90', -# '../../../observations/forward_operators/obs_def_gps_mod.f90', -# '../../../observations/forward_operators/obs_def_vortex_mod.f90', -# '../../../observations/forward_operators/obs_def_rel_humidity_mod.f90', -# '../../../observations/forward_operators/obs_def_dew_point_mod.f90' -# quantity_files = '../../../assimilation_code/modules/observations/atmosphere_quantities_mod.f90' -# / &preprocess_nml overwrite_output = .true. input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90' @@ -267,10 +251,9 @@ '../../../observations/forward_operators/obs_def_vortex_mod.f90', '../../../observations/forward_operators/obs_def_rel_humidity_mod.f90', '../../../observations/forward_operators/obs_def_dew_point_mod.f90' - '../../../observations/forward_operators/obs_def_rttov_mod.f90' - quantity_files = '../../../assimilation_code/modules/observations/default_quantities_mod.f90' + quantity_files = '../../../assimilation_code/modules/observations/atmosphere_quantities_mod.f90' / - + &obs_sequence_tool_nml num_input_files = 1 filename_seq = 'obs_seq.final' From b2b218dbaf0253d6f8d70d2efc8f33912c2e5a65 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 19 Sep 2022 09:34:46 -0600 Subject: [PATCH 031/124] remove whitespace only differences --- models/MITgcm_ocean/model_mod.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index 2dffd80a1c..4c7ad86603 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -291,7 +291,7 @@ module model_mod assimilation_period_seconds, & model_perturbation_amplitude, & model_shape_file, & - mitgcm_variables + mitgcm_variables logical :: go_to_dart = .false. logical :: do_bgc = .false. @@ -527,7 +527,7 @@ subroutine static_init_model() if (do_output()) write( * , *) ' Nx, Ny, Nz = ', Nx, Ny, Nz call parse_variable_input(mitgcm_variables, model_shape_file, nvars, & - var_names, quantity_list, clamp_vals, update_list) + var_names, quantity_list, clamp_vals, update_list) domain_id = add_domain(model_shape_file, nvars, & var_names, quantity_list, clamp_vals, update_list ) @@ -1051,7 +1051,7 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas integer, intent(in) :: var_id ! state variable type(ensemble_type), intent(in) :: state_handle integer, intent(in) :: ens_size -logical, intent(out) :: masked +logical, intent(out) :: masked real(r8) :: get_val(ens_size) integer(i8) :: state_index @@ -1062,9 +1062,9 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas state_index = get_dart_vector_index_new(lon_index, lat_index, level, domain_id, var_id) if (state_index .ne. -1) then - get_val = get_state(state_index,state_handle) + get_val = get_state(state_index,state_handle) else - masked = .true. + masked = .true. endif ! Masked returns false if the value is masked From 1e7e18612e9b5106eceaf650ac3f7a14093830b7 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 19 Sep 2022 14:38:56 -0600 Subject: [PATCH 032/124] get_state_meta data and get_val depth should be r8 --- models/MITgcm_ocean/model_mod.f90 | 184 +++++++++++----------- models/MITgcm_ocean/trans_mitdart_mod.f90 | 1 - 2 files changed, 90 insertions(+), 95 deletions(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index 4c7ad86603..ce6e3367aa 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -57,7 +57,7 @@ module model_mod get_io_clamping_minval use netcdf_utilities_mod, only : nc_open_file_readonly, nc_get_variable, & - nc_get_variable_size + nc_get_dimension_size, nc_close_file use netcdf @@ -256,12 +256,11 @@ module model_mod ! standard MITgcm namelist and filled in here. integer :: Nx=-1, Ny=-1, Nz=-1 ! grid counts for each field +integer :: comp3d=-1 ! size of commpressed variables ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) real(r4), allocatable :: XC_sq(:), YC_sq(:), XG_sq(:), YG_sq(:), ZC_sq(:) -integer :: xcsqsize, ycsqsize, zcsqsize -integer :: shape_file_id real(r8) :: ocean_dynamics_timestep = 900.0_r4 integer :: timestepcount = 0 @@ -281,7 +280,6 @@ module model_mod integer, parameter :: NUM_STATE_TABLE_COLUMNS = 5 character(len=vtablenamelength) :: mitgcm_variables(NUM_STATE_TABLE_COLUMNS, MAX_STATE_VARIABLES ) = ' ' - character(len=256) :: model_shape_file = ' ' integer :: assimilation_period_days = 7 integer :: assimilation_period_seconds = 0 @@ -296,8 +294,9 @@ module model_mod logical :: go_to_dart = .false. logical :: do_bgc = .false. logical :: log_transform = .false. +logical :: compress = .false. -namelist /trans_mitdart_nml/ go_to_dart, do_bgc, log_transform +namelist /trans_mitdart_nml/ go_to_dart, do_bgc, log_transform, compress ! /pkg/mdsio/mdsio_write_meta.F writes the .meta files type MIT_meta_type @@ -331,6 +330,7 @@ subroutine static_init_model() integer :: i, iunit, io integer :: ss, dd +integer :: ncid ! for reading compressed coordinates ! The Plan: ! @@ -531,30 +531,29 @@ subroutine static_init_model() domain_id = add_domain(model_shape_file, nvars, & var_names, quantity_list, clamp_vals, update_list ) -! Open the file -shape_file_id = nc_open_file_readonly(model_shape_file) -! Get the size -call nc_get_variable_size(shape_file_id, 'XC_3D', xcsqsize) -call nc_get_variable_size(shape_file_id, 'YC_3D', ycsqsize) -call nc_get_variable_size(shape_file_id, 'ZC_3D', zcsqsize) - -! Allocate the variable and get the values -allocate(xc_sq(xcsqsize)) -allocate(yc_sq(ycsqsize)) -allocate(zc_sq(zcsqsize)) -allocate(xg_sq(xcsqsize)) -allocate(yg_sq(ycsqsize)) - -call nc_get_variable(shape_file_id, 'XC_3D', XC_sq) -call nc_get_variable(shape_file_id, 'YC_3D', YC_sq) -call nc_get_variable(shape_file_id, 'ZC_3D', ZC_sq) - -! EL: tentative solution of XG values -do i=1, xcsqsize - XG_sq(i) = XC_sq(i) - 0.5*delX(1) ! HK should this be delX(i)? - YG_sq(i) = YC_sq(i) - 0.5*delY(1) -enddo +if (compress) then ! read in compressed coordinates + + ncid = nc_open_file_readonly(model_shape_file) + comp3d = nc_get_dimension_size(ncid, 'comp3d', 'static_init_model', model_shape_file) + + allocate(XC_sq(comp3d)) + allocate(YC_sq(comp3d)) + allocate(ZC_sq(comp3d)) ! ZC is r8 + + allocate(XG_sq(comp3d)) + allocate(YG_sq(comp3d)) + + call nc_get_variable(ncid, 'XCcomp', XC_sq) + call nc_get_variable(ncid, 'YCcomp', YC_sq) + call nc_get_variable(ncid, 'ZCcomp', ZC_sq) + + call nc_get_variable(ncid, 'XGcomp', XG_sq) + call nc_get_variable(ncid, 'YGcomp', YG_sq) + + call nc_close_file(ncid) + +endif model_size = get_domain_size(domain_id) @@ -981,66 +980,55 @@ function lon_dist(lon1, lon2) end function lon_dist -function get_dart_vector_index_new(iloc, jloc, kloc, dom_id, var_id) +function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) +!======================================================================= +! + +! returns the dart vector index for the compressed state integer, intent(in) :: iloc, jloc, kloc integer, intent(in) :: dom_id, var_id -integer(i8) :: get_dart_vector_index_new -real(r4) :: x_var, y_var, z_var ! The target lat, lon, level values +integer(i8) :: get_compressed_dart_vector_index +real(r4) :: lon_var, lat_var, depth_var ! The target lat, lon, depth values integer :: i ! loop counter -logical :: x_close, y_close, z_close +logical :: lon_found, lat_found, depth_found integer :: ct -! integer :: ndims integer(i8) :: offset -! integer :: dsize(NF90_MAX_VAR_DIMS) -! Step 1 offset = get_index_start(dom_id, var_id) -! Step 2 -x_var = XC(iloc) -y_var = YC(jloc) -z_var = ZC(kloc) - -! Set the default value to be -1 -get_dart_vector_index_new = -1 -! Step 3, 4 -do i=1, xcsqsize - x_close = .FALSE. - y_close = .FALSE. - z_close = .FALSE. +lon_var = XC(iloc) !lon +lat_var = YC(jloc) !lat +depth_var = ZC(kloc) !depth + +get_compressed_dart_vector_index = -1 + +! Find the index in the compressed state +! HK you could read in {X,Y,Z}comp_ind if you did not want to do this search +do i=1, comp3d + lon_found = .false. + lat_found = .false. + depth_found = .false. ! If we find the value - if ( XC_sq(i) .eq. x_var ) then - x_close = .TRUE. + if ( XC_sq(i) == lon_var ) then + lon_found = .true. endif - if ( YC_sq(i) .eq. y_var ) then - y_close = .TRUE. + if ( YC_sq(i) == lat_var ) then + lat_found = .true. endif - - if ( ZC_sq(i) .eq. z_var ) then - z_close = .TRUE. + if ( ZC_sq(i) == depth_var ) then + depth_found = .true. endif - if (x_close .and. y_close .and. z_close )then - get_dart_vector_index_new = offset + i - 1 + if (lon_found .and. lat_found .and. depth_found )then + get_compressed_dart_vector_index = offset + i - 1 exit endif enddo -end function get_dart_vector_index_new - -!> The iloc, jloc, and kloc here are the grid indices -!> For example, it might be (1000,1000,50) -!> For the original case, the approach was to find the offset (i.e. where the specific -!> variable starts in the state vector, then add number of values in dimensions to the offset -!> to get the values. +end function get_compressed_dart_vector_index -!> NEW APPROACH: -!> 1. still need to find offset -!> 2. Need to find XC(iloc), YC(jloc), ZC(kloc) -!> 3. Start searching for the values above in XC_sq, YC_sq, ZC_sq (long arrays) -!> 4. return the value and add offset, that should be it. function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, masked) !======================================================================= @@ -1059,30 +1047,27 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas if ( .not. module_initialized ) call static_init_model -state_index = get_dart_vector_index_new(lon_index, lat_index, level, domain_id, var_id) +if (compress) then + + state_index = get_compressed_dart_vector_index(lon_index, lat_index, level, domain_id, var_id) + + if (state_index .ne. -1) then + get_val = get_state(state_index,state_handle) + else + masked = .true. + endif -if (state_index .ne. -1) then - get_val = get_state(state_index,state_handle) else - masked = .true. -endif -! Masked returns false if the value is masked -! A grid variable is assumed to be masked if its value is FVAL. -! Just to maintain legacy, we also assume that A grid variable is assumed -! to be masked if its value is exactly 0. -! See discussion in lat_lon_interpolate. + state_index = get_dart_vector_index(lon_index, lat_index, level, domain_id, var_id) + get_val = get_state(state_index,state_handle) -! MEG CAUTION: THE ABOVE STATEMENT IS INCORRECT -! trans_mitdart already looks for 0.0 and makes them FVAL -! So, in the condition below we don't need to check for zeros -! The only mask is FVAL + masked = .false. + do i=1,ens_size ! HK this is checking the whole ensemble, can you have different masks for each ensemble member? + if(get_val(i) == FVAL) masked = .true. + enddo -! No need to search for fill values now. Default get_state_vector_index_new is -1 -! do i=1,ens_size -! ! if(get_val(i) == FVAL .or. get_val(i) == 0.0_r8 ) masked = .true. -! if(get_val(i) == FVAL) masked = .true. -! enddo +endif end function get_val @@ -1173,19 +1158,30 @@ subroutine get_state_meta_data(index_in, location, qty) call get_model_variable_indices(index_in, iloc, jloc, kloc, kind_index = qty) -! The new array is 1-D +if (compress) then ! all variables ae 1D + lon = XC_sq(iloc) + lat = YC_sq(iloc) + depth = ZC_sq(iloc) + ! Acounting for variables those on staggered grids + if (qty == QTY_U_CURRENT_COMPONENT) lon = XG_sq(iloc) + if (qty == QTY_V_CURRENT_COMPONENT) lat = YG_sq(iloc) +else -lon = XC_sq(iloc) -lat = YC_sq(iloc) -depth = ZC_sq(iloc) + lon = XC(iloc) + lat = YC(jloc) + depth = ZC(kloc) + + ! Acounting for variables those on staggered grids + if (qty == QTY_U_CURRENT_COMPONENT) lon = XG(iloc) + if (qty == QTY_V_CURRENT_COMPONENT) lat = YG(jloc) + +endif -! Acounting for surface variables and those on staggered grids ! MEG: check chl's depth here if (qty == QTY_SEA_SURFACE_HEIGHT .or. & qty == QTY_SURFACE_CHLOROPHYLL) depth = 0.0_r8 -if (qty == QTY_U_CURRENT_COMPONENT) lon = XG_sq(iloc) -if (qty == QTY_V_CURRENT_COMPONENT) lat = YG_sq(iloc) +!HK what is the real,r8 here for? checking for equality? location = set_location(real(lon, r8), real(lat, r8), real(depth, r8), VERTISHEIGHT) end subroutine get_state_meta_data diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index d9bce67510..b9a74a84e4 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -936,7 +936,6 @@ subroutine fill_compressed_coords() !XG,etc read from PARAM04 in static_init_trans real(r4) :: var3d(NX,NY,NZ) -real(r4) :: var2d(NX,NY) integer :: n, i, j, k iunit = get_unit() From 25769ca62da595d9693a20ef6ebe873db54a94d7 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 19 Sep 2022 15:05:27 -0600 Subject: [PATCH 033/124] compressed lon,lat is r4. compressed depth r8 --- models/MITgcm_ocean/model_mod.f90 | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index ce6e3367aa..4493579d90 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -260,7 +260,8 @@ module model_mod ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) -real(r4), allocatable :: XC_sq(:), YC_sq(:), XG_sq(:), YG_sq(:), ZC_sq(:) +real(r4), allocatable :: XC_sq(:), YC_sq(:), XG_sq(:), YG_sq(:) +real(r8), allocatable :: ZC_sq(:) real(r8) :: ocean_dynamics_timestep = 900.0_r4 integer :: timestepcount = 0 @@ -989,18 +990,19 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) integer, intent(in) :: iloc, jloc, kloc integer, intent(in) :: dom_id, var_id integer(i8) :: get_compressed_dart_vector_index -real(r4) :: lon_var, lat_var, depth_var ! The target lat, lon, depth values + +real(r4) :: lon, lat +real(r8) :: depth integer :: i ! loop counter logical :: lon_found, lat_found, depth_found -integer :: ct integer(i8) :: offset offset = get_index_start(dom_id, var_id) -lon_var = XC(iloc) !lon -lat_var = YC(jloc) !lat -depth_var = ZC(kloc) !depth +lon = XC(iloc) !lon +lat = YC(jloc) !lat +depth = ZC(kloc) !depth get_compressed_dart_vector_index = -1 @@ -1011,13 +1013,13 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) lat_found = .false. depth_found = .false. ! If we find the value - if ( XC_sq(i) == lon_var ) then + if ( XC_sq(i) == lon ) then lon_found = .true. endif - if ( YC_sq(i) == lat_var ) then + if ( YC_sq(i) == lat ) then lat_found = .true. endif - if ( ZC_sq(i) == depth_var ) then + if ( ZC_sq(i) == depth ) then depth_found = .true. endif @@ -1151,7 +1153,7 @@ subroutine get_state_meta_data(index_in, location, qty) type(location_type), intent(out) :: location integer, intent(out), optional :: qty -real(r4) :: lat, lon, depth +real(r8) :: lat, lon, depth integer :: iloc, jloc, kloc if ( .not. module_initialized ) call static_init_model @@ -1181,8 +1183,7 @@ subroutine get_state_meta_data(index_in, location, qty) if (qty == QTY_SEA_SURFACE_HEIGHT .or. & qty == QTY_SURFACE_CHLOROPHYLL) depth = 0.0_r8 -!HK what is the real,r8 here for? checking for equality? -location = set_location(real(lon, r8), real(lat, r8), real(depth, r8), VERTISHEIGHT) +location = set_location(lon, lat, depth, VERTISHEIGHT) end subroutine get_state_meta_data From 3e92f58f309925f370839d071c789052e397bab5 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 19 Sep 2022 15:14:31 -0600 Subject: [PATCH 034/124] note on perturbing compressed vs non-compressed state --- models/MITgcm_ocean/model_mod.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index 4493579d90..0901805dcf 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -1390,6 +1390,8 @@ end subroutine nc_write_model_atts !------------------------------------------------------------------ ! Create an ensemble of states from a single state. +! Note if you perturb a compressed state, this will not be bitwise +! with perturbing a non-compressed state. subroutine pert_model_copies(state_ens_handle, ens_size, pert_amp, interf_provided) type(ensemble_type), intent(inout) :: state_ens_handle From 43e74ca9879d5b22d4af207f32c48014d27557de Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 23 Sep 2022 09:31:24 -0600 Subject: [PATCH 035/124] bug-fix: masked initialized to false for compresed and not compressed --- models/MITgcm_ocean/model_mod.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index 0901805dcf..620f54d023 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -1049,6 +1049,8 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas if ( .not. module_initialized ) call static_init_model +masked = .false. + if (compress) then state_index = get_compressed_dart_vector_index(lon_index, lat_index, level, domain_id, var_id) @@ -1064,7 +1066,6 @@ function get_val(lon_index, lat_index, level, var_id, state_handle,ens_size, mas state_index = get_dart_vector_index(lon_index, lat_index, level, domain_id, var_id) get_val = get_state(state_index,state_handle) - masked = .false. do i=1,ens_size ! HK this is checking the whole ensemble, can you have different masks for each ensemble member? if(get_val(i) == FVAL) masked = .true. enddo From e64169565d82c503e39b03ed71b730c73ca88848 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 23 Sep 2022 09:46:17 -0600 Subject: [PATCH 036/124] style: switch tabs for spaces note the get_compressed_dart_vector index needs checking for 2d variables. Is the ZC(kloc)=1? --- models/MITgcm_ocean/model_mod.f90 | 36 +++++++++++++++---------------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index 620f54d023..cafa41c48d 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -1009,24 +1009,24 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) ! Find the index in the compressed state ! HK you could read in {X,Y,Z}comp_ind if you did not want to do this search do i=1, comp3d - lon_found = .false. - lat_found = .false. - depth_found = .false. - ! If we find the value - if ( XC_sq(i) == lon ) then - lon_found = .true. - endif - if ( YC_sq(i) == lat ) then - lat_found = .true. - endif - if ( ZC_sq(i) == depth ) then - depth_found = .true. - endif - - if (lon_found .and. lat_found .and. depth_found )then - get_compressed_dart_vector_index = offset + i - 1 - exit - endif + lon_found = .false. + lat_found = .false. + depth_found = .false. + + if ( XC_sq(i) == lon ) then + lon_found = .true. + endif + if ( YC_sq(i) == lat ) then + lat_found = .true. + endif + if ( ZC_sq(i) == depth ) then + depth_found = .true. + endif + + if (lon_found .and. lat_found .and. depth_found )then + get_compressed_dart_vector_index = offset + i - 1 + exit + endif enddo end function get_compressed_dart_vector_index From 32df048186b0b81ab5f941843c02df4112b562da Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 23 Sep 2022 16:01:30 -0600 Subject: [PATCH 037/124] 2d and staggered variables are incorrect --- models/MITgcm_ocean/model_mod.f90 | 31 ++++++++++++++++++++++++++----- 1 file changed, 26 insertions(+), 5 deletions(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index cafa41c48d..ad9e200729 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -54,7 +54,7 @@ module model_mod get_index_start, get_index_end, & get_dart_vector_index, get_num_variables, & get_domain_size, & - get_io_clamping_minval + get_io_clamping_minval, get_kind_index use netcdf_utilities_mod, only : nc_open_file_readonly, nc_get_variable, & nc_get_dimension_size, nc_close_file @@ -995,6 +995,7 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) real(r8) :: depth integer :: i ! loop counter logical :: lon_found, lat_found, depth_found +integer :: qty integer(i8) :: offset @@ -1004,6 +1005,12 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) lat = YC(jloc) !lat depth = ZC(kloc) !depth +qty = get_kind_index(dom_id, var_id) +if (qty == QTY_U_CURRENT_COMPONENT) lon = XG(iloc) +if (qty == QTY_V_CURRENT_COMPONENT) lat = YG(jloc) + +if (qty == QTY_SEA_SURFACE_HEIGHT .or. qty == QTY_SURFACE_CHLOROPHYLL ) depth = ZC(1) + get_compressed_dart_vector_index = -1 ! Find the index in the compressed state @@ -1013,12 +1020,26 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) lat_found = .false. depth_found = .false. - if ( XC_sq(i) == lon ) then - lon_found = .true. + if (qty == QTY_U_CURRENT_COMPONENT) then + if ( XG_sq(i) == lon ) then + lon_found = .true. + endif + else + if ( XC_sq(i) == lon ) then + lon_found = .true. + endif endif - if ( YC_sq(i) == lat ) then - lat_found = .true. + + if (qty == QTY_V_CURRENT_COMPONENT) then + if (YG_sq(i) == lat) then + lat_found = .true. + endif + else + if ( YC_sq(i) == lat ) then + lat_found = .true. + endif endif + if ( ZC_sq(i) == depth ) then depth_found = .true. endif From 8dcb481e4f01a3080ee4da8b7ee22e4e8c6dcbb6 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 30 Sep 2022 16:40:52 -0600 Subject: [PATCH 038/124] fix: depth dimension first in compression so 2d index search is correct --- models/MITgcm_ocean/model_mod.f90 | 12 +++++++++--- models/MITgcm_ocean/trans_mitdart_mod.f90 | 12 ++++++------ 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index ad9e200729..3e4d763a1d 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -998,6 +998,7 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) integer :: qty integer(i8) :: offset +logical :: is_2d offset = get_index_start(dom_id, var_id) @@ -1009,7 +1010,12 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) if (qty == QTY_U_CURRENT_COMPONENT) lon = XG(iloc) if (qty == QTY_V_CURRENT_COMPONENT) lat = YG(jloc) -if (qty == QTY_SEA_SURFACE_HEIGHT .or. qty == QTY_SURFACE_CHLOROPHYLL ) depth = ZC(1) +is_2d = .false. + +if (qty == QTY_SEA_SURFACE_HEIGHT .or. qty == QTY_SURFACE_CHLOROPHYLL ) then + depth = ZC(1) + is_2d = .true. +endif get_compressed_dart_vector_index = -1 @@ -1043,10 +1049,10 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) if ( ZC_sq(i) == depth ) then depth_found = .true. endif - + if (lon_found .and. lat_found .and. depth_found )then get_compressed_dart_vector_index = offset + i - 1 - exit + return endif enddo diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index b9a74a84e4..29ba2ef3c9 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -946,9 +946,9 @@ subroutine fill_compressed_coords() n = 1 -do i=1,NX - do j=1,NY - do k=1,NZ +do k=1,NZ ! k first so 2d is first + do i=1,NX + do j=1,NY if (var3d(i,j,k) /= binary_fill) then !HK also NaN? XCcomp(n) = XC(i) YCcomp(n) = YC(j) @@ -1004,9 +1004,9 @@ subroutine write_compressed_3d(ncid, varid, var_data) integer :: i,j,k ! loop variables n = 1 -do i = 1, NX - do j = 1, NY - do k = 1 , NZ +do k = 1 , NZ !k first so 2d is first + do i = 1, NX + do j = 1, NY if (var_data(i,j,k) /= FVAL) then comp_var(n) = var_data(i,j,k) n = n + 1 From 03564a44dc41296a41a4e0b78fb00adfe1173508 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 3 Oct 2022 15:57:51 -0600 Subject: [PATCH 039/124] program to expand compressed netcdf to full X,Y,Z --- models/MITgcm_ocean/expand_netcdf.f90 | 149 +++++++++++++++++++++++++ models/MITgcm_ocean/work/quickbuild.sh | 1 + 2 files changed, 150 insertions(+) create mode 100644 models/MITgcm_ocean/expand_netcdf.f90 diff --git a/models/MITgcm_ocean/expand_netcdf.f90 b/models/MITgcm_ocean/expand_netcdf.f90 new file mode 100644 index 0000000000..f463b82df0 --- /dev/null +++ b/models/MITgcm_ocean/expand_netcdf.f90 @@ -0,0 +1,149 @@ +! Uncompress a netcdf fil +program expand_netcdf + +use netcdf_utilities_mod, only: nc_open_file_readonly, nc_get_dimension_size, & + nc_define_dimension, nc_create_file, & + nc_get_variable, nc_close_file, nc_put_variable, & + nc_define_real_variable, nc_end_define_mode, & + nc_add_attribute_to_variable + +use types_mod, only : r4, MISSING_R4 + +use utilities_mod, only : initialize_utilities, finalize_utilities + +use netcdf + +implicit none + +integer :: ncid, ncid_comp, dimid(1), dimlen, ret +integer :: Nx,Ny,Nz +integer :: nvars ! total number of variables in compressed file +integer :: id, n, c! loop variables +integer :: i,j,k, ncomp3d, ncomp2d +character(len=NF90_MAX_NAME) :: varname +real(r4), allocatable :: vals3d(:,:,:), vals2d(:,:), vals_comp(:) +integer, allocatable :: Xcomp_ind(:), Ycomp_ind(:), Zcomp_ind(:) + +call initialize_utilities('expand_netcdf') + +ncid_comp = nc_open_file_readonly('compressed.nc') +ncid = nc_create_file('expanded.nc') + +! get the Nx,Ny,Nz +Nx = nc_get_dimension_size(ncid_comp, 'XC') +Ny = nc_get_dimension_size(ncid_comp, 'YC') +Nz = nc_get_dimension_size(ncid_comp, 'ZC') + +! define Nx,Ny,Nz in the expanded file +call nc_define_dimension(ncid, 'X', Nx) +call nc_define_dimension(ncid, 'Y', Ny) +call nc_define_dimension(ncid, 'Z', Nz) + +! get the compressed size +ncomp2d = nc_get_dimension_size(ncid_comp, 'comp2d') +ncomp3d = nc_get_dimension_size(ncid_comp, 'comp3d') + +allocate(vals_comp(ncomp3d)) +allocate(vals2d(Nx,Ny), vals3d(Nx,Ny,Nz)) + +! read in +allocate(Xcomp_ind(ncomp3d), Ycomp_ind(ncomp3d), Zcomp_ind(ncomp3d)) +call nc_get_variable(ncid_comp, 'Ycomp_ind', Ycomp_ind) +call nc_get_variable(ncid_comp, 'Xcomp_ind', Xcomp_ind) +call nc_get_variable(ncid_comp, 'Zcomp_ind', Zcomp_ind) + + +! get the number of variables +ret = nf90_inquire(ncid_comp, nVariables=nvars) + +! define variables +do id = 1, nvars + ret = nf90_inquire_variable(ncid_comp, id, varname, dimids=dimid) + + ! is a it a compressed state variable? + if (var_of_interest(varname)) then + + ! inquire dimention length (2d or 3d) + ret = nf90_inquire_dimension(ncid_comp, dimid(1), len=dimlen) + + ! define expanded variable + if (dimlen == ncomp3d) then + call nc_define_real_variable(ncid, varname, (/'X','Y','Z'/)) + else + call nc_define_real_variable(ncid, varname, (/'X','Y'/)) + endif + + call nc_add_attribute_to_variable(ncid, varname, 'missing_value', MISSING_R4) + + endif +enddo + +call nc_end_define_mode(ncid) + +! write variables +do id = 1, nvars + ret = nf90_inquire_variable(ncid_comp, id, varname, dimids=dimid) + + ! is a it a compressed state variable? + if (var_of_interest(varname)) then + + ! inquire dimention length (2d or 3d) + ret = nf90_inquire_dimension(ncid_comp, dimid(1), len=dimlen) + + ! read in compressed variable + if (dimlen == ncomp3d) then + call nc_get_variable(ncid_comp, varname, vals_comp) + vals3d = MISSING_R4 + else + call nc_get_variable(ncid_comp, varname, vals_comp(1:ncomp2d)) + vals2d = MISSING_R4 + endif + + ! expand + c = 1 + do n = 1, ncomp3d + i = Xcomp_ind(n) + j = Ycomp_ind(n) + k = Zcomp_ind(n) + if (k == 1 .and. dimlen == ncomp2d) then + vals2d(i,j) = vals_comp(c) + c = c + 1 + else + vals3d(i,j,k) = vals_comp(n) + endif + enddo + + ! write expanded variable + if (dimlen == ncomp3d) then + call nc_put_variable(ncid, varname, vals3d) + else + call nc_put_variable(ncid, varname, vals2d) + endif + + endif +enddo + +call nc_close_file(ncid_comp) +call nc_close_file(ncid) + +call finalize_utilities('expand_netcdf') + +contains + + ! logical to ignore compression variables + function var_of_interest(varname) + character(len=*), intent(in) :: varname + logical :: var_of_interest + + select case (varname) + case ('XGcomp', 'XCcomp', 'YGcomp', 'YCcomp', 'ZCcomp', 'Xcomp_ind', 'Ycomp_ind', 'Zcomp_ind') + var_of_interest = .false. + case ('XC', 'YC', 'ZC', 'XG', 'YG') + var_of_interest = .false. + case default + var_of_interest = .true. + end select + + end function var_of_interest + +end program expand_netcdf diff --git a/models/MITgcm_ocean/work/quickbuild.sh b/models/MITgcm_ocean/work/quickbuild.sh index 80731cfd82..1254788940 100755 --- a/models/MITgcm_ocean/work/quickbuild.sh +++ b/models/MITgcm_ocean/work/quickbuild.sh @@ -34,6 +34,7 @@ model_serial_programs=( dart_to_mit mit_to_dart create_ocean_obs +expand_netcdf ) arguments "$@" From 63c19b5531d60a41e7e5d459438382d980bbf0d6 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 7 Oct 2022 12:00:17 -0600 Subject: [PATCH 040/124] recl2d and recl3d set in static_init_trans Currently hardcoded as *4. May be able to replace this with INQUIRE to get correct recl --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 24 +++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 29ba2ef3c9..0c5696880f 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -45,6 +45,10 @@ module trans_mitdart_mod integer, parameter :: max_nz = 512 integer, parameter :: max_nr = 512 +!-- record lengths for reading/writing binary files +integer :: recl3d +integer :: recl2d + !-- Gridding parameters variable declarations logical :: usingCartesianGrid, usingCylindricalGrid, & usingSphericalPolarGrid, usingCurvilinearGrid, & @@ -216,6 +220,10 @@ subroutine static_init_trans() ZC(i) = ZC(i-1) - 0.5_r8 * delZ(i-1) - 0.5_r8 * delZ(i) enddo +! set record lengths +recl3d = Nx*Ny*Nz*4 +recl2d = Nx*Ny*4 + end subroutine static_init_trans !------------------------------------------------------------------ @@ -630,7 +638,7 @@ subroutine from_mit_to_netcdf_2d(mitfile, ncid, varid) integer :: recl ! datasize*4 real(r4) :: var_data(Nx,Ny) -recl = Nx*Ny*4 +recl = recl2d iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & @@ -662,7 +670,7 @@ subroutine from_mit_to_netcdf_tracer_3d(mitfile, ncid, varid) low_conc = 1.0e-12 -recl = Nx*Ny*Nz*4 +recl = recl3d iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & @@ -713,7 +721,7 @@ subroutine from_mit_to_netcdf_tracer_2d(mitfile, ncid, varid) low_conc = 1.0e-12 -recl = Nx*Ny*Nz*4 +recl = recl3d iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & @@ -763,7 +771,7 @@ subroutine from_netcdf_to_mit_2d(ncid, name) integer :: varid real(r4) :: local_fval -recl = Nx*Ny*4 +recl = recl2d call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) @@ -798,7 +806,7 @@ subroutine from_netcdf_to_mit_3d(ncid, name) integer :: varid real(r4) :: local_fval -recl = Nx*Ny*Nz*4 +recl = recl3d call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) @@ -834,7 +842,7 @@ subroutine from_netcdf_to_mit_tracer(ncid, name) integer :: varid real(r4) :: local_fval -recl = Nx*Ny*Nz*4 +recl = recl3d call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) @@ -876,7 +884,7 @@ function get_compressed_size_3d() result(n3) real(r4) :: var3d(NX,NY,NZ) integer :: i,j,k -recl = Nx*Ny*Nz*4 +recl = recl3d iunit = get_unit() open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & @@ -910,7 +918,7 @@ function get_compressed_size_2d() result(n2) real(r4) :: var2d(NX,NY) integer :: i,j -recl = Nx*Ny*4 +recl = recl2d iunit = get_unit() open(iunit, file='ETA.data', form='UNFORMATTED', status='OLD', & From d54cbfb1517442e4ba1a3fd9b07deb714b182043 Mon Sep 17 00:00:00 2001 From: Ed Liu <42658115+fnrliu@users.noreply.github.com> Date: Fri, 7 Oct 2022 13:45:29 -0600 Subject: [PATCH 041/124] doc: compressed netcdf files MITgcm-DART with compressed netcdf files is based on work by Ed Liu as part of a 2022 SIParCS project --- models/MITgcm_ocean/readme.rst | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/models/MITgcm_ocean/readme.rst b/models/MITgcm_ocean/readme.rst index d63e56fea0..c6b7dc3dfd 100644 --- a/models/MITgcm_ocean/readme.rst +++ b/models/MITgcm_ocean/readme.rst @@ -34,8 +34,14 @@ can be set in the ``&trans_mitdart_nml`` namelist in ``input.nml``. &trans_mitdart_nml do_bgc = .false. ! change to .true. if doing bio-geo-chemistry log_transform = .false. ! change to .true. if using log_transform + compress = .false. ! change to .true. to compress the state vector / +``compress = .true.`` can be used to generate netcdf files for use with DART which has missing values (land) removed. +For some datasets this reduces the state vector size significantly. For example, the state vector size is +reduced by approximately 90% for the Red Sea. The program ``expand_netcdf`` can be used to uncompress the netcdf +file to view the data in a convenient form. + .. Warning:: From cd107d1cf61713384dc23accee43fe4fe724d055 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 11 Oct 2022 09:47:11 -0600 Subject: [PATCH 042/124] Option to output CHL for dart_to_mit CHL is not updated, but may be helpful when testing code. For example, perturbing uncompressed state to get an ensemble of mit .data files to test bitwise between compressed and non-compressed. --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 48 ++++++++++++++++++++++- 1 file changed, 46 insertions(+), 2 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 0c5696880f..9aee7e1ed3 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -24,6 +24,8 @@ module trans_mitdart_mod logical :: log_transform = .false. logical :: compress = .false. ! set compress = .true. remove missing values from state +logical :: output_chl_data = .false. +! CHL.data is not written to mit .data files by default namelist /trans_mitdart_nml/ do_bgc, log_transform, compress @@ -491,6 +493,7 @@ subroutine dart2mit() call from_netcdf_to_mit_tracer(ncid, 'DOP') call from_netcdf_to_mit_tracer(ncid, 'DON') call from_netcdf_to_mit_tracer(ncid, 'FET') + if (output_chl_data) call from_netcdf_to_mit_tracer_chl(ncid, 'CHL') endif call check( NF90_CLOSE(ncid) ) @@ -678,7 +681,7 @@ subroutine from_mit_to_netcdf_tracer_3d(mitfile, ncid, varid) read(iunit,rec=1) var_data close(iunit) -! CHL is treated differently +! CHL is treated differently - HK CHL is 2d so you will not enter this if (mitfile=='CHL.data') then where (var_data == binary_fill) var_data = FVAL @@ -833,7 +836,7 @@ end subroutine from_netcdf_to_mit_3d !------------------------------------------------------------------ subroutine from_netcdf_to_mit_tracer(ncid, name) -integer, intent(in) :: ncid ! which file, +integer, intent(in) :: ncid ! which file character(len=*), intent(in) :: name ! which variable integer :: iunit @@ -873,6 +876,47 @@ subroutine from_netcdf_to_mit_tracer(ncid, name) end subroutine from_netcdf_to_mit_tracer +!------------------------------------------------------------------ +subroutine from_netcdf_to_mit_tracer_chl(ncid, name) + +integer, intent(in) :: ncid ! which file +character(len=*), intent(in) :: name ! which variable + +integer :: iunit +integer :: recl ! datasize*4 +real(r4) :: var(Nx,Ny) +integer :: varid +real(r4) :: local_fval + +recl = recl2d + +call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) +! initialize var to netcdf fill value +var(:,:) = local_fval + +if (compress) then + call read_compressed(ncid, varid, var) +else + call check(nf90_get_var(ncid,varid,var)) +endif + +where (var == local_fval) + var = binary_fill +elsewhere + var = 10**(var) +endwhere + + +iunit = get_unit() +open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & + access='DIRECT', recl=recl, convert='BIG_ENDIAN') +write(iunit,rec=1)var +close(iunit) + +end subroutine from_netcdf_to_mit_tracer_chl + + !------------------------------------------------------------------ ! Assumes all 3D variables are masked in the ! same location From d048a059757c0f5d2af375de74a37e49b32eaa88 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 9 Feb 2023 15:17:36 -0500 Subject: [PATCH 043/124] one place to set recl3d recl2d --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 50 ++++++----------------- 1 file changed, 12 insertions(+), 38 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 9aee7e1ed3..2a7838e567 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -610,14 +610,12 @@ subroutine from_mit_to_netcdf_3d(mitfile, ncid, varid) integer, intent(in) :: ncid, varid ! which file, which variable integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var_data(Nx,Ny,Nz) -recl = Nx*Ny*Ny*4 iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1) var_data close(iunit) @@ -638,14 +636,12 @@ subroutine from_mit_to_netcdf_2d(mitfile, ncid, varid) integer, intent(in) :: ncid, varid ! which file, which variable integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var_data(Nx,Ny) -recl = recl2d iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') read(iunit,rec=1) var_data close(iunit) @@ -667,17 +663,15 @@ subroutine from_mit_to_netcdf_tracer_3d(mitfile, ncid, varid) integer, intent(in) :: ncid, varid ! which file, which variable integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var_data(Nx,Ny,Nz) real(r4) :: low_conc low_conc = 1.0e-12 -recl = recl3d iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1) var_data close(iunit) @@ -718,17 +712,15 @@ subroutine from_mit_to_netcdf_tracer_2d(mitfile, ncid, varid) integer, intent(in) :: ncid, varid ! which file, which variable integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var_data(Nx,Ny) real(r4) :: low_conc low_conc = 1.0e-12 -recl = recl3d iunit = get_unit() ! HK are the mit files big endian by default? open(iunit, file=mitfile, form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1) var_data close(iunit) @@ -769,13 +761,10 @@ subroutine from_netcdf_to_mit_2d(ncid, name) character(len=*), intent(in) :: name ! which variable integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var(Nx,Ny) integer :: varid real(r4) :: local_fval -recl = recl2d - call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) ! initialize var to netcdf fill value @@ -791,7 +780,7 @@ subroutine from_netcdf_to_mit_2d(ncid, name) iunit = get_unit() open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') write(iunit,rec=1)var close(iunit) @@ -804,13 +793,10 @@ subroutine from_netcdf_to_mit_3d(ncid, name) character(len=*), intent(in) :: name ! which variable integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var(Nx,Ny,Nz) integer :: varid real(r4) :: local_fval -recl = recl3d - call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) ! initialize var to netcdf fill value @@ -826,7 +812,7 @@ subroutine from_netcdf_to_mit_3d(ncid, name) iunit = get_unit() open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') write(iunit,rec=1)var close(iunit) @@ -840,13 +826,10 @@ subroutine from_netcdf_to_mit_tracer(ncid, name) character(len=*), intent(in) :: name ! which variable integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var(Nx,Ny,Nz) integer :: varid real(r4) :: local_fval -recl = recl3d - call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) ! initialize var to netcdf fill value @@ -870,7 +853,7 @@ subroutine from_netcdf_to_mit_tracer(ncid, name) iunit = get_unit() open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') write(iunit,rec=1)var close(iunit) @@ -883,13 +866,10 @@ subroutine from_netcdf_to_mit_tracer_chl(ncid, name) character(len=*), intent(in) :: name ! which variable integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var(Nx,Ny) integer :: varid real(r4) :: local_fval -recl = recl2d - call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) ! initialize var to netcdf fill value @@ -910,7 +890,7 @@ subroutine from_netcdf_to_mit_tracer_chl(ncid, name) iunit = get_unit() open(iunit, file=trim(name)//'.data', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') write(iunit,rec=1)var close(iunit) @@ -924,15 +904,12 @@ function get_compressed_size_3d() result(n3) integer :: n3 integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var3d(NX,NY,NZ) integer :: i,j,k -recl = recl3d - iunit = get_unit() open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1) var3d close(iunit) @@ -952,21 +929,18 @@ function get_compressed_size_3d() result(n3) end function get_compressed_size_3d !------------------------------------------------------------------ -! Assumes all 3D variables are masked in the +! Assumes all 2D variables are masked in the ! same location function get_compressed_size_2d() result(n2) integer :: n2 integer :: iunit -integer :: recl ! datasize*4 real(r4) :: var2d(NX,NY) integer :: i,j -recl = recl2d - iunit = get_unit() open(iunit, file='ETA.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl, convert='BIG_ENDIAN') + access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') read(iunit,rec=1) var2d close(iunit) @@ -992,7 +966,7 @@ subroutine fill_compressed_coords() iunit = get_unit() open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=Nx*Ny*Nz*4, convert='BIG_ENDIAN') + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1) var3d close(iunit) From b739460b8c8a0d2780d9ffb40edd21338f1b3ab0 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Thu, 12 Oct 2023 15:41:35 -0600 Subject: [PATCH 044/124] Gather source code from tiegcm and gitm, but no meaningful merges yet. This is the 0th iteration of development, to make a common area for all developers. --- models/aether_cubed-sphere/README | 1 + models/aether_lon-lat/aether_to_netcdf.f90 | 102 ++ models/aether_lon-lat/aether_to_netcdf.nml | 4 + models/aether_lon-lat/aether_to_netcdf.rst | 149 ++ models/aether_lon-lat/dart_aether_mod.f90 | 411 +++++ models/aether_lon-lat/model_mod.f90 | 1586 ++++++++++++++++++++ models/aether_lon-lat/model_mod.nml | 72 + models/aether_lon-lat/netcdf_to_aether.f90 | 161 ++ models/aether_lon-lat/netcdf_to_aether.nml | 4 + models/aether_lon-lat/netcdf_to_aether.rst | 161 ++ 10 files changed, 2651 insertions(+) create mode 100644 models/aether_cubed-sphere/README create mode 100644 models/aether_lon-lat/aether_to_netcdf.f90 create mode 100644 models/aether_lon-lat/aether_to_netcdf.nml create mode 100644 models/aether_lon-lat/aether_to_netcdf.rst create mode 100644 models/aether_lon-lat/dart_aether_mod.f90 create mode 100644 models/aether_lon-lat/model_mod.f90 create mode 100644 models/aether_lon-lat/model_mod.nml create mode 100644 models/aether_lon-lat/netcdf_to_aether.f90 create mode 100644 models/aether_lon-lat/netcdf_to_aether.nml create mode 100644 models/aether_lon-lat/netcdf_to_aether.rst diff --git a/models/aether_cubed-sphere/README b/models/aether_cubed-sphere/README new file mode 100644 index 0000000000..5e91ed3f17 --- /dev/null +++ b/models/aether_cubed-sphere/README @@ -0,0 +1 @@ +This model will be developed after aether_lon-lat. diff --git a/models/aether_lon-lat/aether_to_netcdf.f90 b/models/aether_lon-lat/aether_to_netcdf.f90 new file mode 100644 index 0000000000..80905c30f4 --- /dev/null +++ b/models/aether_lon-lat/aether_to_netcdf.f90 @@ -0,0 +1,102 @@ +! 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 gitm_blocks_to_netcdf + +!---------------------------------------------------------------------- +! purpose: interface between the GITM model and DART +! +! method: Read gitm "restart" files of model state (multiple files, one +! block per gitm mpi task) +! Reform fields into a DART netcdf file +! +! USAGE: The gitm dirname is read from the gitm_in namelist +! +! gitm_blocks_to_netcdf +!---------------------------------------------------------------------- + +use types_mod, only : r8 + +use utilities_mod, only : initialize_utilities, finalize_utilities, & + find_namelist_in_file, check_namelist_read, & + error_handler, E_MSG + +use model_mod, only : restart_files_to_netcdf + +use time_manager_mod, only : time_type, print_time, print_date + +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=512) :: string1, string2 +character(len=*), parameter :: program_name = 'gitm_blocks_to_netcdf' + +!----------------------------------------------------------------------- +! namelist parameters with default values. +!----------------------------------------------------------------------- + +character(len=256) :: gitm_restart_input_dirname = 'none' +character(len=256) :: gitm_to_netcdf_output_file = 'filter_input.nc' + +namelist /gitm_blocks_to_netcdf_nml/ gitm_restart_input_dirname, & + gitm_to_netcdf_output_file + +!---------------------------------------------------------------------- +! global storage +!---------------------------------------------------------------------- + +integer :: iunit, io + +!====================================================================== + +call initialize_utilities(program_name) + +!---------------------------------------------------------------------- +! Read the namelist +!---------------------------------------------------------------------- + +call find_namelist_in_file("input.nml", "gitm_blocks_to_netcdf_nml", iunit) +read(iunit, nml = gitm_blocks_to_netcdf_nml, iostat = io) +call check_namelist_read(iunit, io, "gitm_blocks_to_netcdf_nml") ! closes, too. + +!---------------------------------------------------------------------- +! Convert the files +!---------------------------------------------------------------------- + +call error_handler(E_MSG, '', '') +write(string1,*) 'converting gitm restart files in directory ', & + "'"//trim(gitm_restart_input_dirname)//"'" +write(string2,*) ' to the NetCDF file ', "'"//trim(gitm_to_netcdf_output_file)//"'" +call error_handler(E_MSG, program_name, string1, text2=string2) +call error_handler(E_MSG, '', '') + +call restart_files_to_netcdf(gitm_restart_input_dirname, gitm_to_netcdf_output_file) + +call error_handler(E_MSG, '', '') +write(string1,*) 'Successfully converted the GITM restart files to ', & + "'"//trim(gitm_to_netcdf_output_file)//"'" +call error_handler(E_MSG, program_name, string1) +call error_handler(E_MSG, '', '') + +!---------------------------------------------------------------------- +! Finish up +!---------------------------------------------------------------------- + +! end - close the log, etc +call finalize_utilities() + +end program gitm_blocks_to_netcdf + +! +! $URL$ +! $Id$ +! $Revision$ +! $Date$ diff --git a/models/aether_lon-lat/aether_to_netcdf.nml b/models/aether_lon-lat/aether_to_netcdf.nml new file mode 100644 index 0000000000..c882761107 --- /dev/null +++ b/models/aether_lon-lat/aether_to_netcdf.nml @@ -0,0 +1,4 @@ +&gitm_blocks_to_netcdf_nml + gitm_blocks_to_netcdf_input_file = 'filter_input.nc', + / + diff --git a/models/aether_lon-lat/aether_to_netcdf.rst b/models/aether_lon-lat/aether_to_netcdf.rst new file mode 100644 index 0000000000..33eb3db29d --- /dev/null +++ b/models/aether_lon-lat/aether_to_netcdf.rst @@ -0,0 +1,149 @@ +gitm_blocks_to_netcdf`` +================================= + +.. attention:: + + ``GITM`` works with versions of DART *before* Manhattan (9.x.x) and has yet to be updated. If you are interested in + using ``GITM`` with more recent versions of DART, contact DAReS staff to assess the feasibility of an update. + Until that time, you should consider this documentation as out-of-date. + + +| The `Global Ionosphere Thermosphere Model (GITM) `__ is a + 3-dimensional spherical code that models the Earth's thermosphere and ionosphere system using a stretched grid in + latitude and altitude. For a fuller description of using GITM within DART, please see the :doc:`./readme` documentation. +| ``gitm_blocks_to_netcdf`` is the program that reads GITM restart files (i.e. ``b?????.rst``) and creates a DART + output/restart file (e.g. ``perfect_ics, filter_ics, ...``). +| The list of variables used to create the DART state vector are specified in the ``input.nml`` file. +| Conditions required for successful execution of ``gitm_blocks_to_netcdf``: + +- a valid ``input.nml`` namelist file for DART +- a valid ``UAM.in`` control file for GITM +- a set of ``b?????.rst`` data files for GITM +- a ``header.rst`` file for GITM +- the DART/GITM interfaces must be compiled in a manner consistent with the GITM data and control files. The following + GITM source files are required to build *any* DART interface: + + - models/gitm/GITM2/src/ModConstants.f90 + - models/gitm/GITM2/src/ModEarth.f90 + - models/gitm/GITM2/src/ModKind.f90 + - models/gitm/GITM2/src/ModOrbital.f90 + - models/gitm/GITM2/src/ModSize.f90 + - models/gitm/GITM2/src/ModTime.f90 + - models/gitm/GITM2/src/time_routines.f90 + + Versions of these are included in the DART release. ``ModSize.f90``, in particular, must match what was used to + create the ``b????.rst`` files. + +The individual model instances are run in unique directories. This is also where the converter routines +``gitm_blocks_to_netcdf`` and ``dart_to_gitm`` are run. This makes it easy to use a single 'static' name for the input +and output filenames. ``advance_model.csh`` is responsibile for linking the appropriate files to these static filenames. + +The simplest way to test the converter is to compile GITM and run a single model state forward using ``work/clean.sh``. +To build GITM ... download GITM and unpack the code into ``DART/models/gitm/GITM2`` and follow these instructions: + +.. container:: unix + + :: + + cd models/gitm/GITM2 + ./Config.pl -install -compiler=ifortmpif90 -earth + make + cd ../work + ./clean.sh 1 1 0 150.0 170.0 1.0 + +Namelist +-------- + +We adhere to the F90 standard of starting a namelist with an ampersand '&' and terminating with a slash '/' for all our +namelist input. Character strings that contain a '/' must be enclosed in quotes to prevent them from prematurely +terminating the namelist. + +:: + + &gitm_blocks_to_netcdf_nml + gitm_blocks_to_netcdf_output_file = 'dart_ics', + / + + &model_nml + gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', + assimilation_period_days = 0, + assimilation_period_seconds = 1800, + model_perturbation_amplitude = 0.2, + output_state_vector = .false., + calendar = 'Gregorian', + debug = 0, + gitm_state_variables = 'Temperature', 'QTY_TEMPERATURE', + 'eTemperature', 'QTY_TEMPERATURE_ELECTRON', + 'ITemperature', 'QTY_TEMPERATURE_ION', + 'iO_3P_NDensityS', 'QTY_DENSITY_NEUTRAL_O3P', + ... + ++-----------------------------------+--------------------+-----------------------------------------------------------+ +| Contents | Type | Description | ++===================================+====================+===========================================================+ +| gitm_blocks_to_netcdf_output_file | character(len=128) | The name of the DART file containing the model state | +| | | derived from the GITM restart files. | ++-----------------------------------+--------------------+-----------------------------------------------------------+ + +| + +The full description of the ``model_nml`` namelist is documented in the `gitm model_mod `__, +but the most important variable for ``gitm_blocks_to_netcdf`` is repeated here. + ++---------------------------------------+---------------------------------------+---------------------------------------+ +| Contents | Type | Description | ++=======================================+=======================================+=======================================+ +| gitm_restart_dirname | character(len=256) | The name of the directory containing | +| | | the GITM restart files and runtime | +| | | control information. | ++---------------------------------------+---------------------------------------+---------------------------------------+ +| gitm_state_variables | character(len=32), | The list of variable names in the | +| | dimension(2,80) | gitm restart file to use to create | +| | | the DART state vector and their | +| | | corresponding DART kind. The default | +| | | list is specified in | +| | | model_mod.nml | ++---------------------------------------+---------------------------------------+---------------------------------------+ + +Modules used +------------ + +:: + + obs_def_upper_atm_mod.f90 + assim_model_mod.f90 + types_mod.f90 + location/threed_sphere/location_mod.f90 + models/gitm/GITM2/src/ModConstants.f90 + models/gitm/GITM2/src/ModEarth.f90 + models/gitm/GITM2/src/ModKind.f90 + models/gitm/GITM2/src/ModSize.f90 + models/gitm/GITM2/src/ModTime.f90 + models/gitm/GITM2/src/time_routines.f90 + models/gitm/dart_gitm_mod.f90 + models/gitm/gitm_blocks_to_netcdf.f90 + models/gitm/model_mod.f90 + null_mpi_utilities_mod.f90 + obs_kind_mod.f90 + random_seq_mod.f90 + time_manager_mod.f90 + utilities_mod.f90 + +Files read +---------- + +- gitm restart files: ``b????.rst`` +- gitm control files: ``header.rst`` +- gitm control files: ``UAM.in.rst`` +- DART namelist file: ``input.nml`` + +Files written +------------- + +- DART initial conditions/restart file; e.g. ``dart_ics`` + +References +---------- + +- The official ``GITM`` site is: can be found at + `ccmc.gsfc.nasa.gov/models/modelinfo.php?model=GITM `__ diff --git a/models/aether_lon-lat/dart_aether_mod.f90 b/models/aether_lon-lat/dart_aether_mod.f90 new file mode 100644 index 0000000000..6da8ce6da3 --- /dev/null +++ b/models/aether_lon-lat/dart_aether_mod.f90 @@ -0,0 +1,411 @@ +! 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 dart_gitm_mod + +! This is the interface between the GITM modules and DART. +! To reduce the possibility of scoping issues, all the +! unrestricted GITM modules are confined to this module. + +use ModConstants +use ModSizeGitm +use ModPlanet + +use typesizes +use netcdf + +use utilities_mod, only : error_handler, E_ERR, E_WARN, E_MSG + +implicit none +private + +! these routines must be public and you cannot change +! the arguments - they will be called *from* the DART code. +public :: get_nLatsPerBlock, & + get_nLonsPerBlock, & + get_nAltsPerBlock, & + get_nSpecies, & + get_nSpeciesTotal, & + get_nIons, & + get_nSpeciesAll, & + decode_gitm_indices + +! 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=256) :: string1, string2 + +contains + +!=================================================================== +! All the public interfaces ... nothing more. +!=================================================================== + +! @todo FIXME - should this now get the sizes from the netcdf file +! and not include GITM code? (i think yes.) + +integer function get_nLatsPerBlock() + get_nLatsPerBlock = nLats +end function get_nLatsPerBlock + +integer function get_nLonsPerBlock() + get_nLonsPerBlock = nLons +end function get_nLonsPerBlock + +integer function get_nAltsPerBlock() + get_nAltsPerBlock = nAlts +end function get_nAltsPerBlock + +integer function get_nSpecies() + get_nSpecies = nSpecies ! From ModPlanet, hopefully +end function get_nSpecies + +integer function get_nSpeciesTotal() + get_nSpeciesTotal = nSpeciesTotal ! From ModPlanet, hopefully +end function get_nSpeciesTotal + +integer function get_nIons() + get_nIons = nIons ! From ModPlanet, hopefully +end function get_nIons + +integer function get_nSpeciesAll() + get_nSpeciesAll = nSpeciesAll ! From ModPlanet, hopefully +end function get_nSpeciesAll + + +subroutine decode_gitm_indices( varname, gitm_varname, gitm_dim, gitm_index, & + long_name, units) +! The rosetta stone relating the user input 'strings' to integer indices. +! +! progvar%varname = varname +! progvar%long_name = long_name +! progvar%units = units +! progvar%gitm_varname = gitm_varname +! progvar%gitm_dim = gitm_dim +! progvar%gitm_index = gitm_index + +character(len=*), intent(in) :: varname +character(len=*), intent(out) :: gitm_varname +integer, intent(out) :: gitm_dim, gitm_index +character(len=NF90_MAX_NAME), intent(out) :: long_name +character(len=NF90_MAX_NAME), intent(out) :: units + + + + long_name = 'something real' + units = 'furlongs/fortnight' + + select case (trim(varname)) + + ! The first hunk of these all come from the NDensityS variable, defined to be: + ! do iSpecies=1,nSpeciesTotal + ! write(iRestartUnit_) NDensityS(:,:,:,iSpecies,iBlock) + ! enddo + + case ('iO_3P_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iO_3P_ + long_name = 'density of O3P molecules' + units = 'mol/m3' + + case ('iO2_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iO2_ + long_name = 'density of O2 molecules' + units = 'mol/m3' + + case ('iN2_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iN2_ + long_name = 'density of N2 molecules' + units = 'mol/m3' + + case ('iN_4S_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iN_4S_ + long_name = 'density of N4S molecules' + units = 'mol/m3' + + case ('iNO_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iNO_ + long_name = 'density of NO molecules' + units = 'mol/m3' + + case ('iN_2D_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iN_2D_ + long_name = 'density of N2D molecules' + units = 'mol/m3' + + case ('iN_2P_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iN_2P_ + long_name = 'density of N2P molecules' + units = 'mol/m3' + + case ('iH_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iH_ + long_name = 'density of H molecules' + units = 'mol/m3' + + case ('iHe_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iHe_ + long_name = 'density of He molecules' + units = 'mol/m3' + + case ('iCO2_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iCO2_ + long_name = 'density of CO2 molecules' + units = 'mol/m3' + + case ('iO_1D_NDensityS') + gitm_varname = 'NDensityS' + gitm_dim = 4 + gitm_index = iO_1D_ + long_name = 'density of O1D molecules' + units = 'mol/m3' + + ! The next hunk of these all pertain to the IDensityS variable: + ! do iSpecies=1,nIons + ! write(iRestartUnit_) IDensityS(:,:,:,iSpecies,iBlock) + ! enddo + + case ('iO_4SP_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iO_4SP_ + long_name = 'density of O4SP ions' + units = 'mol/m3' + + case ('iO2P_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iO2P_ + long_name = 'density of O2P ions' + units = 'mol/m3' + + case ('iN2P_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iN2P_ + long_name = 'density of N2P ions' + units = 'mol/m3' + + case ('iNP_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iNP_ + long_name = 'density of NP ions' + units = 'mol/m3' + + case ('iNOP_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iNOP_ + long_name = 'density of NOP ions' + units = 'mol/m3' + + case ('iO_2DP_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iO_2DP_ + long_name = 'density of O2DP ions' + units = 'mol/m3' + + case ('iO_2PP_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iO_2PP_ + long_name = 'density of O2PP ions' + units = 'mol/m3' + + case ('iHP_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iHP_ + long_name = 'density of HP ions' + units = 'mol/m3' + + case ('iHeP_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = iHeP_ + long_name = 'density of HeP ions' + units = 'mol/m3' + + case ('ie_IDensityS') + gitm_varname = 'IDensityS' + gitm_dim = 4 + gitm_index = ie_ + long_name = 'density of the electrons' + units = 'mol/m3' + + case ('Temperature') ! write(iRestartUnit_) Temperature(:,:,:,iBlock)*TempUnit(:,:,:) + gitm_varname = 'Temperature' + gitm_dim = -1 + gitm_index = -1 + long_name = 'temperature (quantity tied to the square of velocity of the particles)' + units = 'Kelvin' + + case ('ITemperature') ! write(iRestartUnit_) ITemperature(:,:,:,iBlock) + gitm_varname = 'ITemperature' + gitm_dim = -1 + gitm_index = -1 + long_name = 'ion temperature (quantity tied to the square of velocity of the ions)' + units = 'Kelvin' + + case ('eTemperature') ! write(iRestartUnit_) eTemperature(:,:,:,iBlock) + gitm_varname = 'eTemperature' + gitm_dim = -1 + gitm_index = -1 + long_name = 'electron temperature (quantity tied to the square of velocity of the electrons)' + units = 'Kelvin' + + case ('U_Velocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) + gitm_varname = 'Velocity' + gitm_dim = 4 + gitm_index = 1 + long_name = 'the U-component of the velocity of the particles' + units = 'm/s' + + case ('V_Velocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) + gitm_varname = 'Velocity' + gitm_dim = 4 + gitm_index = 2 + long_name = 'the V-component of the velocity of the particles' + units = 'm/s' + + case ('W_Velocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) + gitm_varname = 'Velocity' + gitm_dim = 4 + gitm_index = 3 + long_name = 'the W-component of the velocity of the particles' + units = 'm/s' + + case ('U_IVelocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) + gitm_varname = 'IVelocity' + gitm_dim = 4 + gitm_index = 1 + long_name = 'the U-component of the velocity of the ions' + units = 'm/s' + + case ('V_IVelocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) + gitm_varname = 'IVelocity' + gitm_dim = 4 + gitm_index = 2 + long_name = 'the V-component of the velocity of the ions' + units = 'm/s' + + case ('W_IVelocity_component') ! write(iRestartUnit_) IVelocity(:,:,:,iBlock) + gitm_varname = 'IVelocity' + gitm_dim = 4 + gitm_index = 3 + long_name = 'the W-component of the velocity of the ions' + units = 'm/s' + + case ('iO_3P_VerticalVelocity') + gitm_varname = 'VerticalVelocity' + gitm_dim = 4 + gitm_index = iO_3P_ + long_name = 'the vertical velocity of the O3P molecule' + units = 'm/s' + + case ('iO2_VerticalVelocity') + gitm_varname = 'VerticalVelocity' + gitm_dim = 4 + gitm_index = iO2_ + long_name = 'the vertical velocity of the O2 molecule' + units = 'm/s' + + case ('iN2_VerticalVelocity') + gitm_varname = 'VerticalVelocity' + gitm_dim = 4 + gitm_index = iN2_ + long_name = 'the vertical velocity of the N2 molecule' + units = 'm/s' + + case ('iN_4S_VerticalVelocity') + gitm_varname = 'VerticalVelocity' + gitm_dim = 4 + gitm_index = iN_4S_ + long_name = 'the vertical velocity of the N4S molecule' + units = 'm/s' + + case ('iNO_VerticalVelocity') + gitm_varname = 'VerticalVelocity' + gitm_dim = 4 + gitm_index = iNO_ + long_name = 'the vertical velocity of the NO molecule' + units = 'm/s' + + case ('iHe_VerticalVelocity') + gitm_varname = 'VerticalVelocity' + gitm_dim = 4 + gitm_index = iHE_ + long_name = 'the vertical velocity of the He molecule' + units = 'm/s' + + case ('TEC') + gitm_varname = 'TEC' + gitm_dim = -1 + gitm_index = -1 + long_name = 'Vertically integrated total electron content' + units = '10^16 electron/m^2' + + case ('f107') ! write(iRestartUnit_) f107_est !Alex !Does DART assume that anything that has gitm_dim = -1 is 3D? + gitm_varname = 'f107' + gitm_dim = -1 + gitm_index = -1 + long_name = 'f107 solar flux index' + units = '1 Solar Flux Unit 10^-22 Wa m^-2 Hz^-1' + + case ('Rho') + gitm_varname = 'Rho' + gitm_dim = -1 + gitm_index = -1 + long_name = 'mass density' + units = 'kg/m3' + + case default + + write(string1,*)'unknown GITM variable '//trim(varname) + call error_handler(E_ERR,'define_var_dims',string1,source,revision,revdate) + + end select + + +end subroutine decode_gitm_indices + + + + +!=================================================================== +! End of dart_gitm_mod +!=================================================================== +end module dart_gitm_mod + +! +! $URL$ +! $Id$ +! $Revision$ +! $Date$ diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 new file mode 100644 index 0000000000..d5f1ac3087 --- /dev/null +++ b/models/aether_lon-lat/model_mod.f90 @@ -0,0 +1,1586 @@ +! 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 module was copied from models/tiegcm +! but has restart reading and writing routines from ../gitm, +! because the lon-lat grid layout, with halos, and subdomain ("block") file structure +! seems to be the same in GITM and Aether, +! Those subroutines need to be adapted to the infrastructure in this model_mod +! and to the Aether restart files' format and contents. + +! The model_mod.nml initially has the namelists from both tiegcm and gitm. +! Parts of both may be useful and will be merged into a new aether_lon-lat nml. + + +! TODOs from models/tiegcm: +! - Nick Dietrich fix_mmr. When do to this? +! - model_time +! - get_state_meta_data 2D variables +! - test vtec + +module model_mod + +!------------------------------------------------------------------------------- +! +! Interface for HAO-TIEGCM 2.0 +! +!------------------------------------------------------------------------------- + +use types_mod, only : r4, r8, i8, MISSING_R8, MISSING_R4, PI, & + earth_radius, gravity, obstypelength, MISSING_I + +use time_manager_mod, only : time_type, set_calendar_type, set_time_missing, & + set_time, get_time, print_time, & + set_date, get_date, print_date, & + operator(*), operator(+), operator(-), & + operator(>), operator(<), operator(/), & + operator(/=), operator(<=) + +use location_mod, only : location_type, & + get_close_obs, & + loc_get_close_state => get_close_state, & + set_location, get_location, & + get_dist, query_location, & + get_close_type, VERTISUNDEF, & + VERTISPRESSURE, VERTISHEIGHT, VERTISLEVEL, & + vertical_localization_on, set_vertical + +use utilities_mod, only : open_file, close_file, logfileunit, & + error_handler, E_ERR, E_MSG, E_WARN, nmlfileunit, & + do_output, find_namelist_in_file, check_namelist_read, & + do_nml_file, do_nml_term, register_module, & + file_to_text, find_textfile_dims, to_upper + +use obs_kind_mod, only : QTY_U_WIND_COMPONENT, & + QTY_V_WIND_COMPONENT, & + QTY_TEMPERATURE, &! neutral temperature obs + QTY_PRESSURE, &! neutral pressure obs + QTY_MOLEC_OXYGEN_MIXING_RATIO, &! neutral composition obs + QTY_1D_PARAMETER, & + QTY_GEOPOTENTIAL_HEIGHT, & + QTY_GEOMETRIC_HEIGHT, & + QTY_VERTICAL_TEC, &! total electron content + get_index_for_quantity + +use mpi_utilities_mod,only : my_task_id + +use default_model_mod, only : adv_1step, & + init_conditions => fail_init_conditions, & + init_time => fail_init_time, & + nc_write_model_vars, & + pert_model_copies + +use state_structure_mod, only : add_domain, get_dart_vector_index, add_dimension_to_variable, & + finished_adding_domain, state_structure_info, & + get_domain_size, get_model_variable_indices, & + get_num_dims, get_dim_name, get_variable_name, & + get_varid_from_varname, get_num_varids_from_kind, & + get_varid_from_kind, get_varids_from_kind, & + hyperslice_domain, get_num_domains + +use distributed_state_mod, only : get_state, get_state_array + +use ensemble_manager_mod, only : ensemble_type + +use netcdf_utilities_mod, only : nc_synchronize_file, nc_add_global_attribute, & + nc_add_global_creation_time, nc_begin_define_mode, & + nc_define_dimension, nc_end_define_mode, & + nc_put_variable,nc_add_attribute_to_variable, & + nc_define_real_variable, & + nc_check, nc_open_file_readonly, nc_get_dimension_size, & + nc_close_file, nc_get_variable + +use dart_time_io_mod, only : write_model_time + +use netcdf + +implicit none +private + +!DART mandatory public interfaces +public :: get_model_size, & + get_state_meta_data, & + model_interpolate, & + end_model, & + static_init_model, & + nc_write_model_atts, & + nc_write_model_vars, & + get_close_obs, & + get_close_state, & + shortest_time_between_assimilations, & + convert_vertical_obs, & + convert_vertical_state, & + read_model_time, & + write_model_time + +!DART pass through interfaces +public :: adv_1step, & + init_conditions, & + init_time, & + pert_model_copies + +! version controlled file description for error handling, do not edit +character(len=256), parameter :: source = 'tiegcm/model_mod.f90' +character(len=32 ), parameter :: revision = '' +character(len=128), parameter :: revdate = '' + +!------------------------------------------------------------------------------- +! namelist with default values + + +character(len=256) :: tiegcm_restart_file_name = 'tiegcm_restart_p.nc' +character(len=256) :: tiegcm_secondary_file_name = 'tiegcm_s.nc' +integer :: debug = 0 +logical :: estimate_f10_7 = .false. +character(len=256) :: f10_7_file_name = 'f10_7.nc' +integer :: assimilation_period_seconds = 3600 +real(r8) :: model_res = 5.0_r8 + +integer, parameter :: MAX_NUM_VARIABLES = 30 +integer, parameter :: MAX_NUM_COLUMNS = 6 +character(len=NF90_MAX_NAME) :: variables(MAX_NUM_VARIABLES * MAX_NUM_COLUMNS) = ' ' + +namelist /model_nml/ tiegcm_restart_file_name, & + tiegcm_secondary_file_name, & + variables, debug, estimate_f10_7, & + f10_7_file_name, & + assimilation_period_seconds, model_res + + +!------------------------------------------------------------------------------- +! define model parameters + +! nilev is number of interaface levels +! nlev is number of midpoint levels +integer :: nilev, nlev, nlon, nlat +real(r8),dimension(:), allocatable :: lons, lats, levs, ilevs, plevs, pilevs +! levels + top level boundary condition for nlev. +integer :: all_nlev +real(r8),dimension(:), allocatable :: all_levs +! HK are plevs, pilves per ensemble member? +real(r8) :: TIEGCM_reference_pressure +integer :: time_step_seconds +integer :: time_step_days +type(time_type) :: time_step + +! Codes for interpreting the columns of the variable_table +integer, parameter :: VT_VARNAMEINDX = 1 ! variable name +integer, parameter :: VT_KINDINDX = 2 ! DART quantity +integer, parameter :: VT_MINVALINDX = 3 ! minimum value if any +integer, parameter :: VT_MAXVALINDX = 4 ! maximum value if any +integer, parameter :: VT_ORIGININDX = 5 ! file of origin +integer, parameter :: VT_STATEINDX = 6 ! update (state) or not + +character(len=obstypelength) :: variable_table(MAX_NUM_VARIABLES, MAX_NUM_COLUMNS) + +type(time_type) :: state_time ! module-storage declaration of current model time + +integer(i8) :: model_size ! the state vector length +integer :: nfields ! number of tiegcm variables in DART state +! global domain id to be used by routines in state_structure_mod +integer :: domain_id(3) ! restart, secondary, calculate +integer, parameter :: RESTART_DOM = 1 +integer, parameter :: SECONDARY_DOM = 2 +integer, parameter :: CONSTRUCT_DOM = 3 + +! lon and lat grid specs. 2.5 degree or 5 degree grid +real(r8) :: bot_lon = MISSING_R8 +real(r8) :: top_lon = MISSING_R8 +real(r8) :: delta_lon = MISSING_R8 +real(r8) :: bot_lat = MISSING_R8 +real(r8) :: top_lat = MISSING_R8 +real(r8) :: delta_lat = MISSING_R8 +integer :: zero_lon_index = MISSING_I + + +! Obs locations are expected to be given in height [m] or level, +! and so vertical localization coordinate is *always* height. +! Note that gravity adjusted geopotential height (ZG) is read in +! "tiegcm_s.nc". ZG is 'cm', dart is mks +integer :: ivarZG + +character(len=512) :: string1, string2, string3 +logical, save :: module_initialized = .false. + +!=============================================================================== +contains +!=============================================================================== + +subroutine static_init_model() +!------------------------------------------------------------------------------- +! + +integer :: iunit, io + +if (module_initialized) return ! only need to do this once + +! Print module information to log file and stdout. +call register_module(source, revision, revdate) + +module_initialized = .true. + +! Read the namelist entry for model_mod from input.nml +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') + +if (do_nml_file()) write(nmlfileunit, nml=model_nml) +if (do_nml_term()) write( * , nml=model_nml) + +if (do_output()) then + write( * ,*)'static_init_model: debug level is ',debug + write(logfileunit,*)'static_init_model: debug level is ',debug +endif + +! Read in TIEGCM grid definition from TIEGCM restart file +call read_TIEGCM_definition(tiegcm_restart_file_name) + +if ( estimate_f10_7 ) then + call error_handler(E_MSG, 'f10_7 part of DART state', source) +endif + +! error-check, convert namelist input to variable_table, and build the +! state structure +call verify_variables() + +call set_calendar_type('Gregorian') + +! Convert the last year/day/hour/minute to a dart time. +state_time = read_model_time(tiegcm_restart_file_name) + +! Assumes assimilation_period is a multiple of the dynamical timestep +! TIEGCM namelist has variable "STOP" +! which is an array of length 3 corresponding to day-of-year, hour, minute +time_step = set_time(assimilation_period_seconds, 0) + +end subroutine static_init_model + + +!------------------------------------------------------------------------------- + +function get_model_size() +! Returns the size of the model as an integer. + +integer(i8) :: get_model_size + +if ( .not. module_initialized ) call static_init_model + +get_model_size = model_size + +end function get_model_size + + + +!------------------------------------------------------------------------------- + + +subroutine model_interpolate(state_handle, ens_size, location, iqty, obs_val, istatus) +! Given a location, and a model state variable qty, +! interpolates the state variable field to that location. +! obs_val is the interpolated value for each ensemble member +! istatus is the success (0) or failure of the interpolation + +type(ensemble_type), intent(in) :: state_handle +integer, intent(in) :: ens_size +type(location_type), intent(in) :: location +integer, intent(in) :: iqty +real(r8), intent(out) :: obs_val(ens_size) !< array of interpolated values +integer, intent(out) :: istatus(ens_size) + +integer :: which_vert +integer :: lat_below, lat_above, lon_below, lon_above ! these are indices +real(r8) :: lon_fract, lat_fract +real(r8) :: lon, lat, lon_lat_lev(3) +real(r8), dimension(ens_size) :: val11, val12, val21, val22 +real(r8) :: height +integer :: level, bogus_level +integer :: dom_id, var_id + +if ( .not. module_initialized ) call static_init_model + +! Default for failure return +istatus(:) = 1 +obs_val(:) = MISSING_R8 + +! Failure codes +! 11 QTY_GEOPOTENTIAL_HEIGHT is unsupported +! 22 unsupported veritcal coordinate +! 33 level given < or > model levels +! 44 quantity not part of the state +! 55 outside state (can not extrapolate above or below) +! 66 unknown vertical stagger + +! GITM uses a vtec routine in obs_def_upper_atm_mod:get_expected_gnd_gps_vtec() +! TIEGCM has its own vtec routine, so we should use it. This next block ensures that. +! The get_expected_gnd_gps_vtec() tries to interpolate QTY_GEOPOTENTIAL_HEIGHT +! when it does, this will kill it. + +if ( iqty == QTY_GEOPOTENTIAL_HEIGHT ) then + istatus(:) = 11 + write(string1,*)'QTY_GEOPOTENTIAL_HEIGHT currently unsupported' + call error_handler(E_ERR,'model_interpolate',string1,source, revision, revdate) +endif + + +! Get the position +lon_lat_lev = get_location(location) +lon = lon_lat_lev(1) ! degree +lat = lon_lat_lev(2) ! degree +height = lon_lat_lev(3) ! level (int) or height (real) +level = int(lon_lat_lev(3)) + + +which_vert = nint(query_location(location)) + +call compute_bracketing_lat_indices(lat, lat_below, lat_above, lat_fract) +call compute_bracketing_lon_indices(lon, lon_below, lon_above, lon_fract) + +! Pressure is not part of the state vector +! pressure is static data on plevs/pilevs +if ( iqty == QTY_PRESSURE) then + if (which_vert == VERTISLEVEL) then + ! @todo from Lanai code: + ! Some variables need plevs, some need pilevs + ! We only need the height (aka level) + ! the obs_def_upper_atm_mod.f90:get_expected_O_N2_ratio routines queries + ! for the pressure at the model levels - EXACTLY - so ... + ! FIXME ... at present ... the only time model_interpolate + ! gets called with QTY_PRESSURE is to calculate density, which + ! requires other variables that only live on the midpoints. + ! I cannot figure out how to generically decide when to + ! use plevs vs. pilevs + + ! Check to make sure vertical level is possible. + if ((level < 1) .or. (level > nlev)) then + istatus(:) = 33 + return + else + obs_val(:) = plevs(level) + istatus(:) = 0 + endif + elseif (which_vert == VERTISHEIGHT) then + + ! @todo from Lanai code: + ! FIXME ... is it possible to try to get a pressure with which_vert == undefined + ! At present, vert_interp will simply fail because height is a negative number. + ! @todo HK what are you supposed to do for pressure with VERTISUNDEF? level 1? + + call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) + if (any(istatus /= 0)) return ! bail at the first failure + call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) + if (any(istatus /= 0)) return + call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) + if (any(istatus /= 0)) return + call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) + obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) + else + + write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' + call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) + + endif ! which vert + + return + +endif ! end of QTY_PRESSURE + + +if ( iqty == QTY_VERTICAL_TEC ) then ! extrapolate vtec + + call extrapolate_vtec(state_handle, ens_size, lon_below, lat_below, val11) + call extrapolate_vtec(state_handle, ens_size, lon_below, lat_above, val11) + call extrapolate_vtec(state_handle, ens_size, lon_above, lat_below, val11) + call extrapolate_vtec(state_handle, ens_size, lon_above, lat_above, val11) + obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) + istatus(:) = 0 + + return +endif + +! check if qty is in the state vector +call find_qty_in_state(iqty, dom_id, var_id) +if (dom_id < 0 ) then + istatus(:) = 44 + return +endif + +if( which_vert == VERTISHEIGHT ) then + + call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) + if (any(istatus /= 0)) return ! bail at the first failure + call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) + if (any(istatus /= 0)) return + call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) + if (any(istatus /= 0)) return + call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) + obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) + istatus = 0 +elseif( which_vert == VERTISLEVEL) then + ! Check to make sure vertical level is possible. + if ((level < 1) .or. (level > nilev)) then + istatus(:) = 33 + return + endif + + ! one use of model_interpolate is to allow other modules/routines + ! the ability to 'count' the model levels. To do this, create observations + ! with locations on model levels and 'interpolate' for QTY_GEOMETRIC_HEIGHT. + ! When the interpolation fails, you've gone one level too far. + ! HK why does it have to be QTY_GEOMETRIC_HEIGHT? + + val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, level, domain_id(dom_id), var_id ), state_handle) + val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, level, domain_id(dom_id), var_id ), state_handle) + val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, level, domain_id(dom_id), var_id ), state_handle) + val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, level, domain_id(dom_id), var_id ), state_handle) + obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) + istatus = 0 + +elseif( which_vert == VERTISUNDEF) then + bogus_level = 1 !HK what should this be? Do only 2D fields have VERTISUNDEF? + val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) + val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) + val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) + val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) + obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) + istatus(:) = 0 + +else + + write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' + call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) + +endif + +end subroutine model_interpolate + +!------------------------------------------------------------------------------- +function shortest_time_between_assimilations() +type(time_type) :: shortest_time_between_assimilations + +shortest_time_between_assimilations = time_step + +end function shortest_time_between_assimilations + +!------------------------------------------------------------------------------- + + +subroutine get_state_meta_data(index_in, location, var_qty) +! Given an integer index into the state vector, returns the +! associated location and optionally the variable quantity. + +integer(i8), intent(in) :: index_in +type(location_type), intent(out) :: location +integer, optional, intent(out) :: var_qty + +integer :: lon_index, lat_index, lev_index +integer :: local_qty, var_id, dom_id +integer :: seconds, days ! for f10.7 location +real(r8) :: longitude ! for f10.7 location +character(len=NF90_MAX_NAME) :: dim_name + +if ( .not. module_initialized ) call static_init_model + +call get_model_variable_indices(index_in, lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id, kind_index=local_qty) + +if(present(var_qty)) var_qty = local_qty + +if (get_variable_name(dom_id, var_id) == 'f10_7') then + ! f10_7 is most accurately located at local noon at equator. + ! 360.0 degrees in 86400 seconds, 43200 secs == 12:00 UTC == longitude 0.0 + + call get_time(state_time, seconds, days) + longitude = 360.0_r8 * real(seconds,r8) / 86400.0_r8 - 180.0_r8 + if (longitude < 0.0_r8) longitude = longitude + 360.0_r8 + location = set_location(longitude, 0.0_r8, 400000.0_r8, VERTISUNDEF) + return +end if + +! search for either ilev or lev +dim_name = ilev_or_lev(dom_id, var_id) + +select case (trim(dim_name)) + case ('ilev') + location = set_location(lons(lon_index), lats(lat_index), ilevs(lev_index), VERTISLEVEL) + case ('lev') + location = set_location(lons(lon_index), lats(lat_index), levs(lev_index), VERTISLEVEL) + case default + call error_handler(E_ERR, 'get_state_meta_data', 'expecting ilev or ilat dimension') + ! HK @todo 2D variables. +end select + +end subroutine get_state_meta_data + + +!------------------------------------------------------------------------------- + + +subroutine end_model() +! Does any shutdown and clean-up needed for model. + +end subroutine end_model + + +!------------------------------------------------------------------------------- +! Writes the model-specific attributes to a netCDF file. +subroutine nc_write_model_atts( ncid, dom_id ) + +integer, intent(in) :: ncid ! netCDF file identifier +integer, intent(in) :: dom_id + +real(r8), allocatable :: temp_lons(:) +character(len=*), parameter :: routine = 'nc_write_model_atts' + +if ( .not. module_initialized ) call static_init_model + +! Write Global Attributes +call nc_begin_define_mode(ncid, routine) + +call nc_add_global_creation_time(ncid, routine) + +call nc_add_global_attribute(ncid, "model_source", source, routine) +call nc_add_global_attribute(ncid, "model", "TIEGCM", routine) + + +! define grid dimensions +call nc_define_dimension(ncid, 'lon', nlon, routine) +call nc_define_dimension(ncid, 'lat', nlat, routine) +call nc_define_dimension(ncid, 'lev', all_nlev, routine) +call nc_define_dimension(ncid, 'ilev', nilev, routine) + +! define grid variables +! longitude +call nc_define_real_variable( ncid, 'lon', (/ 'lon' /), routine) +call nc_add_attribute_to_variable(ncid, 'lon', 'long_name', 'geographic longitude (-west, +east)', routine) +call nc_add_attribute_to_variable(ncid, 'lon', 'units', 'degrees_east', routine) + +! latitude +call nc_define_real_variable( ncid, 'lat', (/ 'lat' /), routine) +call nc_add_attribute_to_variable(ncid, 'lat', 'long_name', 'geographic latitude (-south, +north)', routine) +call nc_add_attribute_to_variable(ncid, 'lat', 'units', 'degrees_north', routine) + +! levs +call nc_define_real_variable( ncid, 'lev', (/ 'lev' /), routine) +call nc_add_attribute_to_variable(ncid, 'lev', 'long_name', 'midpoint levels', routine) +call nc_add_attribute_to_variable(ncid, 'lev', 'short name', 'ln(p0/p)', routine) +call nc_add_attribute_to_variable(ncid, 'lev', 'positive', 'up', routine) +call nc_add_attribute_to_variable(ncid, 'lev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) +call nc_add_attribute_to_variable(ncid, 'lev', 'formula_terms', 'p0: p0 lev: lev', routine) +call nc_add_attribute_to_variable(ncid, 'lev', 'formula', 'p(k) = p0 * exp(-lev(k))', routine) + + +! ilevs +call nc_define_real_variable( ncid, 'ilev', (/ 'ilev' /), routine) +call nc_add_attribute_to_variable(ncid, 'ilev', 'long_name', 'interface levels', routine) +call nc_add_attribute_to_variable(ncid, 'ilev', 'short name', 'ln(p0/p)', routine) +call nc_add_attribute_to_variable(ncid, 'ilev', 'positive', 'up', routine) +call nc_add_attribute_to_variable(ncid, 'ilev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) +call nc_add_attribute_to_variable(ncid, 'ilev', 'formula_terms', 'p0: p0 lev: ilev', routine) +call nc_add_attribute_to_variable(ncid, 'lev', 'formula', 'p(k) = p0 * exp(-ilev(k))', routine) + + +call nc_end_define_mode(ncid, routine) + +!------------------------------------------------------------------------------- +! Write variables +!------------------------------------------------------------------------------- + +! Fill in the coordinate variables + +! longitude - TIEGCM uses values +/- 180, DART uses values [0,360] +allocate(temp_lons(nlon)) +temp_lons = lons +where (temp_lons >= 180.0_r8) temp_lons = temp_lons - 360.0_r8 +call nc_put_variable(ncid, 'lon', temp_lons, routine) +call nc_put_variable(ncid, 'lat', lats, routine) +call nc_put_variable(ncid, 'lev', all_levs, routine) +call nc_put_variable(ncid, 'ilev', ilevs, routine) +deallocate(temp_lons) + +! flush any pending i/o to disk +call nc_synchronize_file(ncid, routine) + +end subroutine nc_write_model_atts + + +!------------------------------------------------------------------------------- +! Vertical localization is done only in height (ZG). +! obs vertical location is given in height (model_interpolate). +! state vertical location is given in height. +subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & + num_close, close_ind, dist, state_handle) + +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) :: state_handle + +integer :: k, q_ind +integer :: n +integer :: istatus + +n = size(locs) + +if (vertical_localization_on()) then ! need to get height + call convert_vertical_state(state_handle, n, locs, loc_qtys, loc_indx, VERTISHEIGHT, istatus) ! HK Do we care about istatus? +endif + +call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & + num_close, close_ind, dist) + +! Make the ZG part of the state vector far from everything so it does not get updated. +! HK Note if you have inflation on ZG has been inflated. +! Scroll through all the obs_loc(:) and obs_kind(:) elements + +do k = 1,num_close + q_ind = close_ind(k) + if (loc_qtys(q_ind) == QTY_GEOMETRIC_HEIGHT) then + if (do_output() .and. (debug > 99)) then + write( * ,*)'get_close_state ZG distance is ', & + dist(k),' changing to ',10.0_r8 * PI + write(logfileunit,*)'get_close_state ZG distance is ', & + dist(k),' changing to ',10.0_r8 * PI + endif + dist(k) = 10.0_r8 * PI + endif +enddo + + +if (estimate_f10_7) then +! f10_7 is given a location of latitude 0.0 and the longitude +! of local noon. By decreasing the distance from the observation +! to the dynamic f10_7 location we are allowing the already close +! observations to have a larger impact in the parameter estimation. +! 0.25 is heuristic. The 'close' observations have already been +! determined by the cutoff. Changing the distance here does not +! allow more observations to impact anything. + do k = 1, num_close + q_ind = close_ind(k) + if (loc_qtys(q_ind) == QTY_1D_PARAMETER) then + dist(k) = dist(k)*0.25_r8 + endif + enddo +endif + + +end subroutine get_close_state + + +!------------------------------------------------------------------------------- + +subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, & + 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, intent(in) :: loc_types(:) +integer, intent(in) :: which_vert +integer, intent(out) :: istatus(:) + +integer :: current_vert_type, i +real(r8) :: height(1) +integer :: local_status(1) + +character(len=*), parameter :: routine = 'convert_vertical_obs' + +if ( which_vert == VERTISHEIGHT .or. which_vert == VERTISUNDEF) then + istatus(:) = 0 + return +endif + +do i = 1, num + current_vert_type = nint(query_location(locs(i))) + if (( current_vert_type == which_vert ) .or. & + ( current_vert_type == VERTISUNDEF)) then + istatus(i) = 0 + cycle + endif + + call model_interpolate(state_handle, 1, locs(i), QTY_GEOMETRIC_HEIGHT, height, local_status ) + + if (local_status(1) == 0) call set_vertical(locs(i), height(1), VERTISHEIGHT) + istatus(i) = local_status(1) + +enddo + +end subroutine convert_vertical_obs + +!------------------------------------------------------------------------------- +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 + +integer :: var_id, dom_id, lon_index, lat_index, lev_index +integer :: i +real(r8) :: height(1), height1(1), height2(1) +character(len=NF90_MAX_NAME) :: dim_name +integer(i8) :: height_idx + + +if ( which_vert /= VERTISHEIGHT ) then + call error_handler(E_ERR,'convert_vertical_state', 'only supports VERTISHEIGHT') +endif + +istatus = 0 !HK what are you doing with this? + +do i = 1, num + + call get_model_variable_indices(loc_indx(i), lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id) + + ! search for either ilev or lev + dim_name = ilev_or_lev(dom_id, var_id) + + select case (trim(dim_name)) + case ('ilev') + height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & + domain_id(SECONDARY_DOM), ivarZG) + height = get_state(height_idx, state_handle)/100.0_r8 + + case ('lev') ! height on midpoint + height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & + domain_id(SECONDARY_DOM), ivarZG) + height1 = get_state(height_idx, state_handle)/100.0_r8 + height_idx = get_dart_vector_index(lon_index, lat_index, lev_index+1, & + domain_id(SECONDARY_DOM), ivarZG) + height2 = get_state(height_idx, state_handle)/100.0_r8 + height = (height1 + height2) / 2.0_r8 + + case default + call error_handler(E_ERR, 'convert_vertical_state', 'expecting ilev or ilat dimension') + end select + + locs(i) = set_location(lons(lon_index), lats(lat_index), height(1), VERTISHEIGHT) + +end do + +end subroutine convert_vertical_state + +!------------------------------------------------------------------------------- + +function read_model_time(filename) +character(len=*), intent(in) :: filename +type(time_type) :: read_model_time + +integer :: ncid, time_dimlen, dimlen + +integer, parameter :: nmtime = 3 +integer, dimension(nmtime) :: mtime ! day, hour, minute +integer :: year, doy, utsec +integer, allocatable, dimension(:,:) :: mtimetmp +integer, allocatable, dimension(:) :: yeartmp + +character(len=*), parameter :: routine = 'read_model_time' + +ncid = nc_open_file_readonly(filename, routine) + +time_dimlen = nc_get_dimension_size(ncid, 'time', routine) +dimlen = nc_get_dimension_size(ncid, 'mtimedim', routine) + +if (dimlen /= nmtime) then + write(string1, *) trim(filename), ' mtimedim = ',dimlen, ' DART expects ', nmtime + call error_handler(E_ERR,'read_model_time',string1,source,revision,revdate) +endif + +allocate(mtimetmp(dimlen, time_dimlen), yeartmp(time_dimlen)) + +call nc_get_variable(ncid, 'mtime', mtimetmp, routine) +call nc_get_variable(ncid, 'year', yeartmp, routine) + +! pick off the latest/last +mtime = mtimetmp(:,time_dimlen) +year = yeartmp( time_dimlen) + +deallocate(mtimetmp,yeartmp) + +doy = mtime(1) +utsec = (mtime(2)*60 + mtime(3))*60 +read_model_time = set_time(utsec, doy-1) + set_date(year, 1, 1) ! Jan 1 of whatever year. + +if (do_output()) then + write(*,*) trim(filename)//':read_model_time: tiegcm [year, doy, hour, minute]', & + year, mtime + call print_date(read_model_time, str=trim(filename)//':read_model_time: date ') + call print_time(read_model_time, str=trim(filename)//':read_model_time: time ') +endif + +call nc_close_file(ncid, routine, filename) + +end function read_model_time + + +!=============================================================================== +! Routines below here are private to the module +!=============================================================================== + +subroutine read_TIEGCM_definition(file_name) +! Read TIEGCM grid definition from a tiegcm restart file +! fills metadata storage variables: +! lons(:), nlon +! lats(:), nlat +! lev(:), nlev +! ilev(:), nilev +! plevs(:) +! pilevs(:) +! Converts the tiegcm longitude (-+180) to (0 360) +! Sets the grid specs + +character(len=*), intent(in) :: file_name +integer :: ncid, DimID, TimeDimID +real(r8) :: p0 + +character(len=*), parameter :: routine = 'read_TIEGCM_definition' + +call error_handler(E_MSG,routine,'reading restart ['//trim(file_name)//']') + +ncid = nc_open_file_readonly(file_name, routine) + +! longitude - TIEGCM uses values +/- 180, DART uses values [0,360] +nlon = nc_get_dimension_size(ncid, 'lon', routine) +allocate(lons(nlon)) +call nc_get_variable(ncid, 'lon', lons, routine) +where (lons < 0.0_r8) lons = lons + 360.0_r8 + +! latitiude +nlat = nc_get_dimension_size(ncid, 'lat', routine) +allocate(lats(nlat)) +call nc_get_variable(ncid, 'lat', lats, routine) + +! pressure +call nc_get_variable(ncid, 'p0', p0, routine) +TIEGCM_reference_pressure = p0 + +! level +all_nlev = nc_get_dimension_size(ncid, 'lev', routine) +! top level is not viable. The lower boundary condition is stored in the top level +nlev = all_nlev - 1 +allocate(all_levs(all_nlev),levs(nlev), plevs(nlev)) +call nc_get_variable(ncid, 'lev', all_levs, routine) + +levs=all_levs(1:nlev) +plevs = p0 * exp(-levs) * 100.0_r8 ![Pa] = 100* [millibars] = 100* [hPa] + +! ilevel +nilev = nc_get_dimension_size(ncid, 'ilev', routine) +allocate(ilevs(nilev), pilevs(nilev)) +call nc_get_variable(ncid, 'ilev', ilevs, routine) + +pilevs = p0 * exp(-ilevs) * 100.0_r8 ! [Pa] = 100* [millibars] = 100* [hPa] + +if ((nlev+1) .ne. nilev) then + write(string1,*) 'number of midpoints should be 1 less than number of interfaces.' !HK is the top level for nilev not a boundary condition? + write(string2,*) 'number of midpoints is nlev = ',nlev + write(string3,*) 'number of interfaces is nilev = ',nilev + call error_handler(E_MSG,'read_TIEGCM_definition', string1, & + source, revision, revdate, text2=string2, text3=string3) +endif + + +! Get lon and lat grid specs +bot_lon = lons(1) ! 180. +delta_lon = abs((lons(1)-lons(2))) ! 5. or 2.5 +zero_lon_index = int(bot_lon/delta_lon) + 1 ! 37 or 73 +top_lon = lons(nlon) ! 175. or 177.5 +bot_lat = lats(1) ! +top_lat = lats(nlat) ! +delta_lat = abs((lats(1)-lats(2))) ! + +end subroutine read_TIEGCM_definition + +!------------------------------------------------------------------------------- +! Fill up the variable_table from the namelist item 'variables' +! The namelist item variables is where a user specifies +! which variables they want in the DART state: +! variable name, dart qty, clamping min, clamping max, origin file, update or not + +subroutine verify_variables() + +integer :: nfields_restart ! number of variables from restart file +integer :: nfields_secondary ! number of variables from secondary file +integer :: nfields_constructed ! number of constructed state variables + +integer :: i, nrows, ncols + +character(len=NF90_MAX_NAME) :: varname +character(len=NF90_MAX_NAME) :: dartstr +character(len=NF90_MAX_NAME) :: minvalstring +character(len=NF90_MAX_NAME) :: maxvalstring +character(len=NF90_MAX_NAME) :: filename +character(len=NF90_MAX_NAME) :: state_or_aux + +nrows = size(variable_table,1) ! these are MAX_NUM_VARIABLES, MAX_NUM_COLUMNS +ncols = size(variable_table,2) + +! Convert the (input) 1D array "variables" into a table with six columns. +! The number of rows in the table correspond to the number of variables in the +! DART state vector. +! Column 1 is the netCDF variable name. +! Column 2 is the corresponding DART kind. +! Column 3 is the minimum value ("NA" if there is none) Not Applicable +! Column 4 is the maximum value ("NA" if there is none) Not Applicable +! Column 5 is the file of origin tiegcm 'restart' or 'secondary' +! Column 6 is whether or not the variable should be updated in the restart file. + +nfields = 0 +nfields_restart = 0 +nfields_secondary = 0 +nfields_constructed = 0 + +ROWLOOP : do i = 1, nrows + + varname = trim(variables(ncols*i - 5)) + dartstr = trim(variables(ncols*i - 4)) + minvalstring = trim(variables(ncols*i - 3)) + maxvalstring = trim(variables(ncols*i - 2)) + filename = trim(variables(ncols*i - 1)) + state_or_aux = trim(variables(ncols*i )) + + call to_upper(filename) + call to_upper(state_or_aux) ! update or not + + variable_table(i,VT_VARNAMEINDX) = trim(varname) + variable_table(i,VT_KINDINDX) = trim(dartstr) + variable_table(i,VT_MINVALINDX) = trim(minvalstring) + variable_table(i,VT_MAXVALINDX) = trim(maxvalstring) + variable_table(i,VT_ORIGININDX) = trim(filename) + variable_table(i,VT_STATEINDX) = trim(state_or_aux) + + ! If the first element is empty, we have found the end of the list. + if ((variable_table(i,1) == ' ') ) exit ROWLOOP + + ! Any other condition is an error. + if ( any(variable_table(i,:) == ' ') ) then + string1 = 'input.nml &model_nml:variables not fully specified.' + string2 = 'Must be 6 entries per variable, last known variable name is' + string3 = trim(variable_table(i,1)) + call error_handler(E_ERR,'get_variables_in_domain',string1, & + source,revision,revdate,text2=string2,text3=string3) + endif + + nfields=nfields+1 + if (variable_table(i,VT_ORIGININDX) == 'RESTART') nfields_restart = nfields_restart+1 + if (variable_table(i,VT_ORIGININDX) == 'SECONDARY') nfields_secondary = nfields_secondary+1 + if (variable_table(i,VT_ORIGININDX) == 'CALCULATE') nfields_constructed = nfields_constructed + 1 + +enddo ROWLOOP + +! Record the contents of the DART state vector +if (do_output() .and. (debug > 99)) then + do i = 1,nfields + write(*,'(''variable'',i4,'' is '',a12,1x,a32,4(1x,a20))') i, & + trim(variable_table(i,1)), & + trim(variable_table(i,2)), & + trim(variable_table(i,3)), & + trim(variable_table(i,4)), & + trim(variable_table(i,5)), & + trim(variable_table(i,6)) + write(logfileunit,'(''variable'',i4,'' is '',a12,1x,a32,4(1x,a20))') i, & + trim(variable_table(i,1)), & + trim(variable_table(i,2)), & + trim(variable_table(i,3)), & + trim(variable_table(i,4)), & + trim(variable_table(i,5)), & + trim(variable_table(i,6)) + enddo +endif + +if (nfields_secondary == 0) call error_handler(E_ERR, 'ZG is required in &model_nml::variables', source) + +call load_up_state_structure_from_file(tiegcm_restart_file_name, nfields_restart, 'RESTART', RESTART_DOM) +call load_up_state_structure_from_file(tiegcm_secondary_file_name, nfields_secondary, 'SECONDARY', SECONDARY_DOM) + +if (estimate_f10_7) then + if (nfields_constructed == 0) then + call error_handler(E_ERR, 'expecting f10.7 in &model_nml::variables', source) + endif + call load_up_state_structure_from_file(f10_7_file_name, nfields_constructed, 'CALCULATE', CONSTRUCT_DOM) + model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) & + + get_domain_size(CONSTRUCT_DOM) +else + model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) +endif + +! set ivar. ZG is in the secondary domain +ivarZG = get_varid_from_varname(domain_id(SECONDARY_DOM), 'ZG') + +end subroutine verify_variables + +!------------------------------------------------------------------------------- +! Adds a domain to the state structure from a netcdf file +! Called from verify_variables +subroutine load_up_state_structure_from_file(filename, nvar, domain_name, domain_num) + +character(len=*), intent(in) :: filename ! filename to read from +integer, intent(in) :: nvar ! number of variables in domain +character(len=*), intent(in) :: domain_name ! restart, secondary +integer, intent(in) :: domain_num + +integer :: i,j + +character(len=NF90_MAX_NAME), allocatable :: var_names(:) +real(r8), allocatable :: clamp_vals(:,:) +integer, allocatable :: kind_list(:) +logical, allocatable :: update_list(:) + + +allocate(var_names(nvar), kind_list(nvar), & + clamp_vals(nvar,2), update_list(nvar)) + +update_list(:) = .true. ! default to update state variable +clamp_vals(:,:) = MISSING_R8 ! default to no clamping + +j = 0 +do i = 1, nfields + if (variable_table(i,VT_ORIGININDX) == trim(domain_name)) then + j = j+1 + var_names(j) = variable_table(i, VT_VARNAMEINDX) + kind_list(j) = get_index_for_quantity(variable_table(i, VT_KINDINDX)) + if (variable_table(i, VT_MINVALINDX) /= 'NA') then + read(variable_table(i, VT_MINVALINDX), '(d16.8)') clamp_vals(j,1) + endif + if (variable_table(i, VT_MAXVALINDX) /= 'NA') then + read(variable_table(i, VT_MAXVALINDX), '(d16.8)') clamp_vals(j,2) + endif + if (variable_table(i, VT_STATEINDX) == 'NO_COPY_BACK') then + update_list(j) = .false. + endif + endif +enddo + +domain_id(domain_num) = add_domain(filename, nvar, & + var_names, kind_list, clamp_vals, update_list) + +! remove top level from all lev variables - this is the boundary condition +call hyperslice_domain(domain_id(domain_num), 'lev', nlev) + +deallocate(var_names, kind_list, clamp_vals, update_list) + +end subroutine load_up_state_structure_from_file +!------------------------------------------------------------------------------- + +subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) +! +! Create the vTEC from constituents in state. +! + +type(ensemble_type), intent(in) :: state_handle +integer, intent(in) :: ens_size +integer, intent(in) :: lon_index, lat_index +real(r8), intent(out) :: vTEC(ens_size) + +! n(i)levs x ensmeble size +real(r8), allocatable, dimension(:,:) :: NE, ZG +real(r8), allocatable, dimension(:,:) :: TI, TE +real(r8), allocatable, dimension(:,:) :: NEm_extended, ZG_extended +real(r8), allocatable, dimension(:,:) :: delta_ZG, NE_middle +real(r8), dimension(ens_size) :: GRAVITYtop, Tplasma, Hplasma + +real(r8), PARAMETER :: k_constant = 1.381e-23_r8 ! m^2 * kg / s^2 / K +real(r8), PARAMETER :: omass = 2.678e-26_r8 ! mass of atomic oxgen kg + +real(r8) :: earth_radiusm +integer :: nlevX, nilevX, j, i, var_id +integer(i8) :: idx + +! NE,ZG are extrapolated +! 20 more layers for 2.5 degree resolution +! 10 more layers for 5 degree resolution +if (model_res == 2.5) then + nlevX = nlev + 20 + nilevX = nilev + 20 +else + nlevX = nlev + 10 + nilevX = nilev + 10 +endif + + +allocate( NE(nilev, ens_size), NEm_extended(nilevX, ens_size), & + ZG(nilev, ens_size), ZG_extended(nilevX, ens_size)) +allocate( TI(nlev, ens_size), TE(nlev, ens_size) ) +allocate( delta_ZG(nlevX-1, ens_size), NE_middle(nlevX-1, ens_size) ) + +! NE (interfaces) +var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'NE') +do i = 1, nilev + idx = get_dart_vector_index(lon_index,lat_index, i, & + domain_id(RESTART_DOM), var_id) + NE(i, :) = get_state(idx, state_handle) +enddo + +! ZG (interfaces) +do i = 1, nilev + idx = get_dart_vector_index(lon_index,lat_index, i, & + domain_id(RESTART_DOM), var_id) + ZG(i, :) = get_state(idx, state_handle) +enddo + +! TI (midpoints) +var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TI') +do i = 1, nlev + idx = get_dart_vector_index(lon_index,lat_index, i, & + domain_id(RESTART_DOM), var_id) + TI(i, :) = get_state(idx, state_handle) +enddo + +! TE (midpoints) +var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TE') +do i = 1, nlev + idx = get_dart_vector_index(lon_index,lat_index, i, & + domain_id(RESTART_DOM), var_id) + TE(i, :) = get_state(idx, state_handle) +enddo + +! Construct vTEC given the parts + +earth_radiusm = earth_radius * 1000.0_r8 ! Convert earth_radius in km to m +NE = NE * 1.0e+6_r8 ! Convert NE in #/cm^3 to #/m^3 + +! Gravity at the top layer +GRAVITYtop(:) = gravity * (earth_radiusm / (earth_radiusm + ZG(nilev,:))) ** 2 + +! Plasma Temperature +Tplasma(:) = (TI(nlev-1,:) + TE(nlev-1,:)) / 2.0_r8 + +! Compute plasma scale height +Hplasma(:) = (2.0_r8 * k_constant / omass ) * Tplasma(:) / GRAVITYtop(:) + +ZG_extended(1:nilev,:) = ZG +NEm_extended(1:nilev,:) = NE + +do j = nlev, nlevX + NEm_extended(j,:) = NEm_extended(j-1,:) * exp(-0.5_r8) + ZG_extended(j,:) = ZG_extended(j-1,:) + Hplasma(:) / 2.0_r8 +enddo + +delta_ZG(1:(nlevX-1),:) = ZG_extended(2:nlevX,:) - ZG_extended(1:(nlevX-1),:) +NE_middle(1:(nlevX-1),:) = (NEm_extended(2:nlevX,:) + NEm_extended(1:(nlevX-1),:)) / 2.0_r8 + +do i = 1, ens_size + vTEC(i) = sum(NE_middle(:,i) * delta_ZG(:,i)) * 1.0e-16_r8 ! Convert to TECU (1.0e+16 #/m^2) +enddo + +deallocate( NE, NEm_extended, ZG, ZG_extended) +deallocate( TI, TE ) +deallocate( delta_ZG, NE_middle ) + +end subroutine extrapolate_vtec + + +!------------------------------------------------------------------------------- + +subroutine vert_interp(state_handle, n, dom_id, var_id, lon_index, lat_index, height, iqty, & + val, istatus) +! returns the value at an arbitrary height on an existing horizontal grid location. +! istatus == 0 is success. + +type(ensemble_type), intent(in) :: state_handle +integer, intent(in) :: n ! ensemble_size +integer, intent(in) :: dom_id +integer, intent(in) :: var_id +integer, intent(in) :: lon_index +integer, intent(in) :: lat_index +real(r8), intent(in) :: height +integer, intent(in) :: iqty +real(r8), intent(out) :: val(n) +integer, intent(out) :: istatus(n) + +logical :: is_pressure +character(len=NF90_MAX_NAME) :: vertstagger + +! Presume the worst. Failure. +istatus = 1 +val = MISSING_R8 + +is_pressure = (iqty == QTY_PRESSURE) +if (is_pressure) then + vertstagger = 'ilev' +else + vertstagger = ilev_or_lev(dom_id, var_id) +endif + +if (vertstagger == 'ilev') then + call vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pressure, & + dom_id, var_id, val, istatus) +elseif (vertstagger == 'lev') then + call vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & + dom_id, var_id, val, istatus) +endif + +end subroutine vert_interp + +!------------------------------------------------------------------------------- +subroutine find_qty_in_state(iqty, which_dom, var_id) +! Returns the variable id for a given DART qty +! Will return X rather than X_MN variable. + +integer, intent(in) :: iqty +integer, intent(out) :: which_dom +integer, intent(out) :: var_id + +integer :: num_same_kind, id, k +integer, allocatable :: multiple_kinds(:), n +character(NF90_MAX_NAME) :: varname + +which_dom = -1 +var_id = -1 + +do id = 1, get_num_domains() ! RESTART_DOM, SECONDARY_DOM, CONSTRUCT_DOM + + num_same_kind = get_num_varids_from_kind(domain_id(id), iqty) + if (num_same_kind == 0 ) cycle + if (num_same_kind > 1 ) then ! need to pick which one you want + which_dom = id + allocate(multiple_kinds(num_same_kind)) + call get_varids_from_kind(domain_id(id), iqty, multiple_kinds) + do k = 1, num_same_kind + varname = adjustl(get_variable_name(domain_id(id), multiple_kinds(k))) + n = len(trim(varname)) + if (n <= 2) then ! variable name can not be X_MN + var_id = multiple_kinds(k) + exit + elseif (trim(varname(n-2:n)) == '_NM') then ! variable name is _MN + cycle ! assuming we want the X, not the X_MN + else + var_id = multiple_kinds(k) + exit + endif + enddo + deallocate(multiple_kinds) + else ! + which_dom = id + var_id = get_varid_from_kind(domain_id(id), iqty) + endif +enddo + +end subroutine find_qty_in_state + +!------------------------------------------------------------------------------- +! find enclosing lon indices +! Compute bracketing lon indices: +! TIEGCM [-180 175] DART [180, 185, ..., 355, 0, 5, ..., 175] +subroutine compute_bracketing_lon_indices(lon, idx_below, idx_above, fraction) + +real(r8), intent(in) :: lon ! longitude +integer, intent(out) :: idx_below, idx_above ! index in lons() +real(r8), intent(out) :: fraction ! fraction to use for interpolation + +if(lon >= top_lon .and. lon < bot_lon) then ! at wraparound point [175 <= lon < 180] + idx_below = nlon + idx_above = 1 + fraction = (lon - top_lon) / delta_lon +elseif (lon >= bot_lon) then ! [180 <= lon <= 360] + idx_below = int((lon - bot_lon) / delta_lon) + 1 + idx_above = idx_below + 1 + fraction = (lon - lons(idx_below)) / delta_lon +else ! [0 <= lon <= 175 ] + idx_below = int((lon - 0.0_r8) / delta_lon) + zero_lon_index + idx_above = idx_below + 1 + fraction = (lon - lons(idx_below)) / delta_lon +endif + + +end subroutine compute_bracketing_lon_indices + +!------------------------------------------------------------------------------- +! on ilev +subroutine vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pressure, & + dom_id, var_id, val, istatus) + +type(ensemble_type), intent(in) :: state_handle +real(r8), intent(in) :: height +integer, intent(in) :: n ! ensemble size +integer, intent(in) :: lon_index +integer, intent(in) :: lat_index +logical, intent(in) :: is_pressure +integer, intent(in) :: dom_id, var_id +real(r8), intent(out) :: val(n) ! interpolated value +integer, intent(out) :: istatus(n) + +integer :: lev_bottom(n) +integer :: lev_top(n) +real(r8) :: frac_lev(n) +integer :: k, i +real(r8) :: zgrid(n), delta_z(n), z2(n), zgrid_top(n), zgrid_bottom(n) +logical :: found(n) ! track which ensemble members have been located +real(r8) :: val_top(n), val_bottom(n) +integer(i8) :: indx_top(n), indx_bottom(n) ! state vector indice + +istatus = 1 +found = .false. + + zgrid_bottom(:) = get_state(get_dart_vector_index(lon_index,lat_index,1, & + domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 + zgrid_top(:) = get_state(get_dart_vector_index(lon_index,lat_index, nilev, & + domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 + + ! cannot extrapolate below bottom or beyond top + do i = 1, n + if ((zgrid_bottom(i) > height) .or. (zgrid_top(i) < height)) then + istatus(i) = 55 + endif + enddo + if (any(istatus == 55)) return ! fail if any ensemble member fails + + ! Figure out what level is above/below, and by how much + h_loop_interface : do k = 2, nilev + + zgrid(:) = get_state(get_dart_vector_index(lon_index,lat_index,k, & + domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 + + ! per ensemble member + do i = 1, n + if (found(i)) cycle + if (height <= zgrid(i)) then + found(i) = .true. + lev_top(i) = k + lev_bottom(i) = lev_top(i) - 1 + if (all(found)) exit h_loop_interface + endif + enddo + + enddo h_loop_interface + + do i = 1, n + indx_top(i) = get_dart_vector_index(lon_index,lat_index,lev_top(i), domain_id(SECONDARY_DOM), ivarZG) + indx_bottom(i) = get_dart_vector_index(lon_index,lat_index,lev_bottom(i), domain_id(SECONDARY_DOM), ivarZG) + enddo + + call get_state_array(zgrid(:), indx_top(:), state_handle) + + call get_state_array(z2(:), indx_bottom(:), state_handle) + + where (zgrid == z2) ! avoid divide by zero + frac_lev = 0.0_r8 + delta_z = 0.0_r8 + elsewhere + delta_z = (zgrid - z2)/100.0_r8 + frac_lev = (zgrid/100.0_r8 - height)/delta_z + endwhere + + if (is_pressure) then ! get fom plevs (pilevs?) array @todo HK Lanai is always plves + + val_top(:) = plevs(lev_top(:)) !pressure at midpoint [Pa] + val_bottom(:) = plevs(lev_bottom(:)) !pressure at midpoint [Pa] + val(:) = exp(frac_lev(:) * log(val_bottom(:)) + (1.0 - frac_lev(:)) * log(val_top(:))) + + else ! get from state vector + + do i = 1, n + indx_top(i) = get_dart_vector_index(lon_index,lat_index,lev_top(i), dom_id, var_id) + indx_bottom(i) = get_dart_vector_index(lon_index,lat_index,lev_bottom(i), dom_id, var_id) + enddo + + call get_state_array(val_top, indx_top(:), state_handle) + call get_state_array(val_bottom, indx_bottom(:), state_handle) + + val(:) = frac_lev(:) * val_bottom(:) + (1.0 - frac_lev(:)) * val_top(:) + + endif + + istatus(:) = 0 + +end subroutine vert_interp_ilev + +!------------------------------------------------------------------------------- +! on lev +subroutine vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & + dom_id, var_id, val, istatus) + +type(ensemble_type), intent(in) :: state_handle +real(r8), intent(in) :: height +integer, intent(in) :: n ! ensemble size +integer, intent(in) :: lon_index +integer, intent(in) :: lat_index +logical, intent(in) :: is_pressure +integer, intent(in) :: dom_id, var_id +real(r8), intent(out) :: val(n) ! interpolated value +integer, intent(out) :: istatus(n) + +integer :: lev(n), lev_minus_one(n), lev_plus_one(n) +real(r8) :: frac_lev(n) + +integer :: k, i +real(r8) :: delta_z(n) +real(r8) :: zgrid_upper(n), zgrid_lower(n) ! ZG on midpoints +real(r8) :: z_k(n), z_k_minus_one(n), z_k_plus_one(n) ! ZG on ilves +integer(i8) :: indx_top(n), indx_bottom(n) ! state vector indices for qty +integer(i8) :: indx(n), indx_minus_one(n), indx_plus_one(n) ! state vector indices for ZG +logical :: found(n) ! track which ensemble members have been located +real(r8) :: val_top(n), val_bottom(n) + +istatus = 1 +found = .false. + + ! Variable is on level midpoints, not ilevels. + ! Get height as the average of the ilevels. + + ! ilev index 1 2 3 4 ... 27 28 29 + ! ilev value -7.00, -6.50, -6.00, -5.50, ... 6.00, 6.50, 7.00 ; + ! lev value -6.75, -6.25, -5.75, -5.25, ... 6.25, 6.75 + ! lev index 1 2 3 4 ... 27 28 + + !mid_level 1 + zgrid_lower(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,1, & + domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & + (get_state(get_dart_vector_index(lon_index,lat_index,2, & + domain_id(SECONDARY_DOM), ivarZG), state_handle) /100.0_r8) ) / 2.0_r8 + + !mid_level nlev + zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,nilev-1, & + domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & + (get_state(get_dart_vector_index(lon_index,lat_index,nilev, & + domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) ) / 2.0_r8 + + ! cannot extrapolate below bottom or beyond top + do i = 1, n + if ((zgrid_lower(i) > height) .or. (zgrid_upper(i) < height)) then + istatus(i) = 55 + endif + enddo + if (any(istatus == 55)) return ! ! fail if any ensemble member fails + + ! Figure out what level is above/below, and by how much + h_loop_midpoint: do k = 2, nilev-1 + + zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,k, & + domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 ) + & + (get_state(get_dart_vector_index(lon_index,lat_index,k+1, & + domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) ) / 2.0_r8 + + ! per ensemble member + do i = 1, n + if (found(i)) cycle + if (height <= zgrid_upper(i)) then + found(i) = .true. + lev(i) = k + lev_minus_one(i) = lev(i) - 1 + lev_plus_one(i) = lev(i) + 1 + if (all(found)) exit h_loop_midpoint + endif + enddo + + enddo h_loop_midpoint + + do i = 1, n + indx(i) = get_dart_vector_index(lon_index,lat_index,lev(i), domain_id(SECONDARY_DOM), ivarZG) + indx_minus_one(i) = get_dart_vector_index(lon_index,lat_index,lev_minus_one(i), domain_id(SECONDARY_DOM), ivarZG) + indx_plus_one(i) = get_dart_vector_index(lon_index,lat_index,lev_plus_one(i), domain_id(SECONDARY_DOM), ivarZG) + enddo + + call get_state_array(z_k(:),indx(:), state_handle) + call get_state_array(z_k_minus_one, indx_minus_one(:), state_handle) + call get_state_array(z_k_plus_one, indx_plus_one(:), state_handle) + + + !lower midpoint + zgrid_lower(:) = ( z_k(:) + z_k_minus_one ) / 2.0_r8 / 100.0_r8 + + ! upper midpoint + zgrid_upper(:) = ( z_k(:) + z_k_plus_one ) / 2.0_r8 / 100.0_r8 + + where (zgrid_upper == zgrid_lower) ! avoid divide by zero + frac_lev = 0.0_r8 + delta_z = 0.0_r8 + elsewhere + delta_z = zgrid_upper - zgrid_lower + frac_lev = (zgrid_upper - height)/delta_z + endwhere + +if (is_pressure) then ! get fom plevs + + val_top(:) = plevs(lev(:)) !pressure at midpoint [Pa] + val_bottom(:) = plevs(lev_minus_one(:)) !pressure at midpoint [Pa] + val(:) = exp(frac_lev(:) * log(val_bottom(:)) + (1.0 - frac_lev(:)) * log(val_top(:))) + +else ! get from state vector + + do i = 1, n + indx_top(i) = get_dart_vector_index(lon_index,lat_index,lev(i), dom_id, var_id) + indx_bottom(i) = get_dart_vector_index(lon_index,lat_index,lev_minus_one(i), dom_id, var_id) + enddo + + call get_state_array(val_top, indx_top(:), state_handle) + call get_state_array(val_bottom, indx_bottom(:), state_handle) + + val(:) = frac_lev(:) * val_bottom(:) + (1.0 - frac_lev(:)) * val_top(:) + +endif + +istatus(:) = 0 + +end subroutine vert_interp_lev + +!------------------------------------------------------------------------------- +! Compute neighboring lat rows: TIEGCM [-87.5, 87.5] DART [-90, 90] +! Poles >|87.5| set to |87.5| +subroutine compute_bracketing_lat_indices(lat, idx_below, idx_above, fraction) + +real(r8), intent(in) :: lat ! latitude +integer, intent(out) :: idx_below, idx_above ! index in lats() +real(r8), intent(out) :: fraction ! fraction to use for interpolation + +if(lat >= bot_lat .and. lat < top_lat) then ! -87.5 <= lat < 87.5 + idx_below = int((lat - bot_lat) / delta_lat) + 1 + idx_above = idx_below + 1 + fraction = (lat - lats(idx_below) ) / delta_lat +else if(lat < bot_lat) then ! South of bottom lat + idx_below = 1 + idx_above = 1 + fraction = 1.0_r8 +else ! On or North of top lat + idx_below = nlat + idx_above = nlat + fraction = 1.0_r8 +endif + +end subroutine compute_bracketing_lat_indices + +!------------------------------------------------------------------------------- +function interpolate(n, lon_fract, lat_fract, val11, val12, val21, val22) result(obs_val) + +integer, intent(in) :: n ! number of ensemble members +real(r8), intent(in) :: lon_fract, lat_fract +real(r8), dimension(n), intent(in) :: val11, val12, val21, val22 +real(r8), dimension(n) :: obs_val + +real(r8) :: a(n, 2) + +a(:, 1) = lon_fract * val21(:) + (1.0_r8 - lon_fract) * val11(:) +a(:, 2) = lon_fract * val22(:) + (1.0_r8 - lon_fract) * val12(:) + +obs_val(:) = lat_fract * a(:,2) + (1.0_r8 - lat_fract) * a(:,1) + +end function interpolate + +!------------------------------------------------------------------------------- +function ilev_or_lev(dom_id, var_id) result(dim_name) + +integer, intent(in) :: dom_id +integer, intent(in) :: var_id +character(len=NF90_MAX_NAME) :: dim_name + +integer :: d +! search for either ilev or lev +dim_name = 'null' +do d = 1, get_num_dims(dom_id, var_id) + dim_name = get_dim_name(dom_id, var_id, d) + if (dim_name == 'ilev' .or. dim_name == 'lev') exit +enddo + +end function ilev_or_lev +!=============================================================================== +! End of model_mod +!=============================================================================== +end module model_mod diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml new file mode 100644 index 0000000000..9e59c55307 --- /dev/null +++ b/models/aether_lon-lat/model_mod.nml @@ -0,0 +1,72 @@ +TIEGCM: +&model_nml + debug = 1 + tiegcm_restart_file_name = 'tiegcm_restart_p.nc' + tiegcm_secondary_file_name = 'tiegcm_s.nc' + estimate_f10_7 = .false. + f10_7_file_name = 'f10_7.nc' + assimilation_period_seconds = 3600 + variables = 'NE', 'QTY_ELECTRON_DENSITY', '1000.0', 'NA', 'restart', 'UPDATE' + 'OP', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', + 'TI', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'restart', 'UPDATE', + 'TE', 'QTY_TEMPERATURE_ELECTRON', 'NA', 'NA', 'restart', 'UPDATE', + 'OP_NM', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', + 'O1', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.99999', 'restart', 'NO_COPY_BACK', + 'O2', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.99999', 'restart', 'UPDATE', + 'TN', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'UPDATE', + 'ZG', 'QTY_GEOMETRIC_HEIGHT', 'NA', 'NA', 'secondary', 'NO_COPY_BACK', + / + + +GITM: +# The list of variables to put into the state vector is here: +# The definitions for the DART kinds are in DART/obs_def/obs_def*f90 +# The order doesn't matter to DART. It may to you. + +&model_nml + gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', + assimilation_period_days = 0, + assimilation_period_seconds = 1800, + model_perturbation_amplitude = 0.2, + calendar = 'Gregorian', + debug = 0, + gitm_state_variables = + 'Temperature', 'QTY_TEMPERATURE', + 'eTemperature', 'QTY_TEMPERATURE_ELECTRON', + 'ITemperature', 'QTY_TEMPERATURE_ION', + 'iO_3P_NDensityS', 'QTY_DENSITY_NEUTRAL_O3P', + 'iO2_NDensityS', 'QTY_DENSITY_NEUTRAL_O2', + 'iN2_NDensityS', 'QTY_DENSITY_NEUTRAL_N2', + 'iN_4S_NDensityS', 'QTY_DENSITY_NEUTRAL_N4S', + 'iNO_NDensityS', 'QTY_DENSITY_NEUTRAL_NO', + 'iN_2D_NDensityS', 'QTY_DENSITY_NEUTRAL_N2D', + 'iN_2P_NDensityS', 'QTY_DENSITY_NEUTRAL_N2P', + 'iH_NDensityS', 'QTY_DENSITY_NEUTRAL_H', + 'iHe_NDensityS', 'QTY_DENSITY_NEUTRAL_HE', + 'iCO2_NDensityS', 'QTY_DENSITY_NEUTRAL_CO2', + 'iO_1D_NDensityS', 'QTY_DENSITY_NEUTRAL_O1D', + 'iO_4SP_IDensityS', 'QTY_DENSITY_ION_O4SP', + 'iO2P_IDensityS', 'QTY_DENSITY_ION_O2P', + 'iN2P_IDensityS', 'QTY_DENSITY_ION_N2P', + 'iNP_IDensityS', 'QTY_DENSITY_ION_NP', + 'iNOP_IDensityS', 'QTY_DENSITY_ION_NOP', + 'iO_2DP_IDensityS', 'QTY_DENSITY_ION_O2DP', + 'iO_2PP_IDensityS', 'QTY_DENSITY_ION_O2PP', + 'iHP_IDensityS', 'QTY_DENSITY_ION_HP', + 'iHeP_IDensityS', 'QTY_DENSITY_ION_HEP', + 'ie_IDensityS', 'QTY_DENSITY_ION_E', + 'U_Velocity_component', 'QTY_VELOCITY_U', + 'V_Velocity_component', 'QTY_VELOCITY_V', + 'W_Velocity_component', 'QTY_VELOCITY_W', + 'U_IVelocity_component', 'QTY_VELOCITY_U_ION', + 'V_IVelocity_component', 'QTY_VELOCITY_V_ION', + 'W_IVelocity_component', 'QTY_VELOCITY_W_ION', + 'iO_3P_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_O3P', + 'iO2_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_O2', + 'iN2_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_N2', + 'iN_4S_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_N4S', + 'iNO_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_NO', + 'f107', 'QTY_1D_PARAMETER', + 'Rho', 'QTY_DENSITY', + / + diff --git a/models/aether_lon-lat/netcdf_to_aether.f90 b/models/aether_lon-lat/netcdf_to_aether.f90 new file mode 100644 index 0000000000..9879cf42d0 --- /dev/null +++ b/models/aether_lon-lat/netcdf_to_aether.f90 @@ -0,0 +1,161 @@ +! 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 netcdf_to_gitm_blocks + +!---------------------------------------------------------------------- +! purpose: interface between DART and the GITM model +! +! method: Read DART state netcdf files and overwrite values in a gitm restart file. +! +! this version assumes that the grid is global and the data needs to be +! blocked into one block per gitm mpi task. there is a different converter +! for when gitm only needs a single input/output file. +! +!---------------------------------------------------------------------- + +use types_mod, only : r8 + +use utilities_mod, only : initialize_utilities, finalize_utilities, & + find_namelist_in_file, check_namelist_read, & + open_file, close_file, E_MSG, error_handler + +use model_mod, only : netcdf_to_restart_files + +use time_manager_mod, only : time_type, print_time, print_date, operator(-), & + get_time, get_date + +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=*), parameter :: progname = 'netcdf_to_gitm_blocks' + +!----------------------------------------------------------------------- +! namelist parameters with default values. +!----------------------------------------------------------------------- + +character (len = 256) :: gitm_restart_input_dirname = 'none' +character (len = 256) :: gitm_restart_output_dirname = 'none' +character (len = 256) :: netcdf_to_gitm_blocks_input_file = 'filter_restart.nc' + +namelist /netcdf_to_gitm_blocks_nml/ & + gitm_restart_input_dirname, & + gitm_restart_output_dirname, & + netcdf_to_gitm_blocks_input_file + +!---------------------------------------------------------------------- +! global storage +!---------------------------------------------------------------------- + +integer :: iunit, io +character(len=512) :: string1, string2, string3 + +!====================================================================== + +call initialize_utilities(progname=progname) + +!---------------------------------------------------------------------- +! Read the namelist. +!---------------------------------------------------------------------- + +call find_namelist_in_file("input.nml", "netcdf_to_gitm_blocks_nml", iunit) +read(iunit, nml = netcdf_to_gitm_blocks_nml, iostat = io) +call check_namelist_read(iunit, io, "netcdf_to_gitm_blocks_nml") + +call error_handler(E_MSG,progname,'','',revision,revdate) +write(string1,*) 'converting DART file ', "'"//trim(netcdf_to_gitm_blocks_input_file)//"'" +write(string2,*) 'to gitm restart files in directory ', "'"//trim(gitm_restart_output_dirname)//"'" +write(string3,*) 'using the restart files in directory ', "'"//trim(gitm_restart_input_dirname)//"' as a template" +call error_handler(E_MSG,progname,string1,source,revision,revdate,text2=string2,text3=string3) + +!---------------------------------------------------------------------- +! Reads the valid time, the state, and the target time. +!---------------------------------------------------------------------- + +call netcdf_to_restart_files(netcdf_to_gitm_blocks_input_file,gitm_restart_output_dirname,& + gitm_restart_input_dirname) + +!---------------------------------------------------------------------- +! Log what we think we're doing, and exit. +!---------------------------------------------------------------------- +call error_handler(E_MSG,progname,'','',revision,revdate) +call error_handler(E_MSG,progname,'','',revision,revdate) +write(string1,*) 'Successfully converted to the gitm restart files in directory' +write(string2,*) "'"//trim(gitm_restart_output_dirname)//"'" +call error_handler(E_MSG,progname,string1,source,revision,revdate,text2=string2) + +! end - close the log, etc +call finalize_utilities() + +!====================================================================== +contains +!====================================================================== + +subroutine write_gitm_time_control(model_time, adv_to_time) +! The idea is to write a text file with the following structure: +! +!#TIMESTART +!2003 year +!06 month +!21 day +!00 hour +!00 minute +!00 second +! +!#TIMEEND +!2003 year +!07 month +!21 day +!00 hour +!00 minute +!00 second +! + +type(time_type), intent(in) :: model_time, adv_to_time +integer :: iyear,imonth,iday,ihour,imin,isec + +iunit = open_file('DART_GITM_time_control.txt', action='write') +write(iunit,*) + +! the end time comes first. + +call get_date(adv_to_time,iyear,imonth,iday,ihour,imin,isec) +write(iunit,'(''#TIMEEND'')') +write(iunit,'(i4.4,10x,''year'' )')iyear +write(iunit,'(i2.2,12x,''month'' )')imonth +write(iunit,'(i2.2,12x,''day'' )')iday +write(iunit,'(i2.2,12x,''hour'' )')ihour +write(iunit,'(i2.2,12x,''minute'')')imin +write(iunit,'(i2.2,12x,''second'')')isec +write(iunit,*) + +call get_date(model_time,iyear,imonth,iday,ihour,imin,isec) +write(iunit,'(''#TIMESTART'')') +write(iunit,'(i4.4,10x,''year'' )')iyear +write(iunit,'(i2.2,12x,''month'' )')imonth +write(iunit,'(i2.2,12x,''day'' )')iday +write(iunit,'(i2.2,12x,''hour'' )')ihour +write(iunit,'(i2.2,12x,''minute'')')imin +write(iunit,'(i2.2,12x,''second'')')isec +write(iunit,*) + +call close_file(iunit) +end subroutine write_gitm_time_control + + + +end program netcdf_to_gitm_blocks + +! +! $URL$ +! $Id$ +! $Revision$ +! $Date$ diff --git a/models/aether_lon-lat/netcdf_to_aether.nml b/models/aether_lon-lat/netcdf_to_aether.nml new file mode 100644 index 0000000000..7e47acd4d5 --- /dev/null +++ b/models/aether_lon-lat/netcdf_to_aether.nml @@ -0,0 +1,4 @@ +&netcdf_to_gitm_blocks_nml + netcdf_to_gitm_blocks_input_file = 'filter_output.nc', + / + diff --git a/models/aether_lon-lat/netcdf_to_aether.rst b/models/aether_lon-lat/netcdf_to_aether.rst new file mode 100644 index 0000000000..a65d7b3e11 --- /dev/null +++ b/models/aether_lon-lat/netcdf_to_aether.rst @@ -0,0 +1,161 @@ +PROGRAM ``netcdf_to_gitm_blocks`` +================================= + +.. attention:: + + ``GITM`` works with versions of DART *before* Manhattan (9.x.x) and has yet to be updated. If you are interested in + using ``GITM`` with more recent versions of DART, contact DAReS staff to assess the feasibility of an update. + Until that time, you should consider this documentation as out-of-date. + + +| The `Global Ionosphere Thermosphere Model (GITM) `__ is a + 3-dimensional spherical code that models the Earth's thermosphere and ionosphere system using a stretched grid in + latitude and altitude. For a fuller description of using GITM within DART, please see the :doc:`./readme` documentation. +| ``netcdf_to_gitm_blocks`` is the program that updates the GITM restart files (i.e. ``b?????.rst``) with the + information from a DART output/restart file (e.g. ``perfect_ics, filter_ics, ...``). +| The list of variables used to create the DART state vector are specified in the ``input.nml`` file. +| Conditions required for successful execution of ``netcdf_to_gitm_blocks``: + +- a valid ``input.nml`` namelist file for DART +- a valid ``UAM.in`` control file for GITM +- a set of ``b?????.rst`` data files for GITM +- a ``header.rst`` file for GITM +- the DART/GITM interfaces must be compiled in a manner consistent with the GITM data and control files. The following + GITM source files are required to build *any* DART interface: + + - models/gitm/GITM2/src/ModConstants.f90 + - models/gitm/GITM2/src/ModEarth.f90 + - models/gitm/GITM2/src/ModKind.f90 + - models/gitm/GITM2/src/ModOrbital.f90 + - models/gitm/GITM2/src/ModSize.f90 + - models/gitm/GITM2/src/ModTime.f90 + - models/gitm/GITM2/src/time_routines.f90 + + Versions of these are included in the DART release. ``ModSize.f90``, in particular, must match what was used to + create the ``b????.rst`` files. + +The individual model instances are run in unique directories. This is also where the converter routines ``gitm_to_dart`` +and ``netcdf_to_gitm_blocks`` are run. This makes it easy to use a single 'static' name for the input and output +filenames. ``advance_model.csh`` is responsibile for linking the appropriate files to these static filenames. + +The simplest way to test the converter is to compile GITM and run a single model state forward using ``work/clean.sh``. +To build GITM ... download GITM and unpack the code into ``DART/models/gitm/GITM2`` and follow these instructions: + +.. container:: unix + + :: + + cd models/gitm/GITM2 + ./Config.pl -install -compiler=ifortmpif90 -earth + make + cd ../work + ./clean.sh 1 1 0 150.0 170.0 1.0 + + And then manually run ``netcdf_to_gitm_blocks`` on the result. + +Namelist +-------- + +We adhere to the F90 standard of starting a namelist with an ampersand '&' and terminating with a slash '/' for all our +namelist input. Character strings that contain a '/' must be enclosed in quotes to prevent them from prematurely +terminating the namelist. + +:: + + &netcdf_to_gitm_blocks_nml + netcdf_to_gitm_blocks_output_file = 'dart_restart', + advance_time_present = .false. + / + + &model_nml + gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', + assimilation_period_days = 0, + assimilation_period_seconds = 1800, + model_perturbation_amplitude = 0.2, + output_state_vector = .false., + calendar = 'Gregorian', + debug = 0, + gitm_state_variables = 'Temperature', 'QTY_TEMPERATURE', + 'eTemperature', 'QTY_TEMPERATURE_ELECTRON', + 'ITemperature', 'QTY_TEMPERATURE_ION', + 'iO_3P_NDensityS', 'QTY_DENSITY_NEUTRAL_O3P', + ... + ++-----------------------------------+--------------------+-----------------------------------------------------------+ +| Contents | Type | Description | ++===================================+====================+===========================================================+ +| netcdf_to_gitm_blocks_output_file | character(len=128) | The name of the DART file containing the model state | +| | | derived from the GITM restart files. | ++-----------------------------------+--------------------+-----------------------------------------------------------+ +| advance_time_present | logical | If you are manually converting a DART initial conditions | +| | | or restart file this should be ``.false.``; these files | +| | | have a single timestamp describing the valid time of the | +| | | model state. If ``.true.``, TWO timestamps are expected | +| | | in the DART file header and | +| | | ``DART_GITM_time_control.txt``) is created with the | +| | | settings appropriate to advance GITM to the time | +| | | requested by DART. | ++-----------------------------------+--------------------+-----------------------------------------------------------+ + +| + +The full description of the ``model_nml`` namelist is documented in the `gitm model_mod `__, +but the most important variable for ``netcdf_to_gitm_blocks`` is repeated here. + ++---------------------------------------+---------------------------------------+---------------------------------------+ +| Contents | Type | Description | ++=======================================+=======================================+=======================================+ +| gitm_restart_dirname | character(len=256) | The name of the directory containing | +| | | the GITM restart files and runtime | +| | | control information. | ++---------------------------------------+---------------------------------------+---------------------------------------+ +| gitm_state_variables | character(len=32), | The list of variable names in the | +| | dimension(2,80) | gitm restart file to use to create | +| | | the DART state vector and their | +| | | corresponding DART kind. The default | +| | | list is specified in | +| | | model_mod.nml | ++---------------------------------------+---------------------------------------+---------------------------------------+ + +Modules used +------------ + +:: + + obs_def_upper_atm_mod.f90 + assim_model_mod.f90 + types_mod.f90 + location/threed_sphere/location_mod.f90 + models/gitm/GITM2/src/ModConstants.f90 + models/gitm/GITM2/src/ModEarth.f90 + models/gitm/GITM2/src/ModKind.f90 + models/gitm/GITM2/src/ModSize.f90 + models/gitm/GITM2/src/ModTime.f90 + models/gitm/GITM2/src/time_routines.f90 + models/gitm/dart_gitm_mod.f90 + models/gitm/netcdf_to_gitm_blocks.f90 + models/gitm/model_mod.f90 + null_mpi_utilities_mod.f90 + obs_kind_mod.f90 + random_seq_mod.f90 + time_manager_mod.f90 + utilities_mod.f90 + +Files read +---------- + +- gitm restart files: ``b????.rst`` +- gitm control files: ``header.rst`` +- gitm control files: ``UAM.in.rst`` +- DART namelist file: ``input.nml`` + +Files written +------------- + +- DART initial conditions/restart file; e.g. ``dart_ics`` + +References +---------- + +- The official ``GITM`` site is: can be found at + `ccmc.gsfc.nasa.gov/models/modelinfo.php?model=GITM `__ From d2186f4f22e9eab5c09c4466fcf57a1130c47db9 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 17 Oct 2023 09:18:58 -0600 Subject: [PATCH 045/124] Merged gitm subroutines into a copy of tiegcm model_mod These subroutines are for reading restart block (subdomain) files. The entry point to them is through program aether_to_dart.f90, which calls model_mod.f90:restart_files_to_netcdf. Also updated aether_to_dart.f90 and aether_to_dart.nml to replace gitm with aether. I copied the tiegcm/work directory in order to compile. It may have domain-related files which should be removed. Among the many things that need to be fixed: - the model_mod headers have not been merged, so it doesn't compile - global variable definitions - global variable allocations and initializations - removing extra 'domain's used in tiegcm - replacing variable names having TIEGCM and GITM (case independent) with Aether. All of this code is untested. --- ...ether_to_netcdf.f90 => aether_to_dart.f90} | 40 +- models/aether_lon-lat/aether_to_dart.nml | 5 + ...ether_to_netcdf.rst => aether_to_dart.rst} | 0 models/aether_lon-lat/aether_to_netcdf.nml | 4 - ...etcdf_to_aether.f90 => dart_to_aether.f90} | 0 ...etcdf_to_aether.nml => dart_to_aether.nml} | 0 ...etcdf_to_aether.rst => dart_to_aether.rst} | 0 models/aether_lon-lat/model_mod.f90 | 1202 ++++++++++++++++- models/aether_lon-lat/work/f10_7.cdl | 10 + models/aether_lon-lat/work/f10_7.nc | Bin 0 -> 156 bytes models/aether_lon-lat/work/input.nml | 375 +++++ .../work/out_restart_p_files.txt | 20 + .../work/out_secondary_files.txt | 20 + models/aether_lon-lat/work/quickbuild.sh | 48 + .../aether_lon-lat/work/restart_p_files.txt | 1 + .../aether_lon-lat/work/secondary_files.txt | 1 + 16 files changed, 1667 insertions(+), 59 deletions(-) rename models/aether_lon-lat/{aether_to_netcdf.f90 => aether_to_dart.f90} (67%) create mode 100644 models/aether_lon-lat/aether_to_dart.nml rename models/aether_lon-lat/{aether_to_netcdf.rst => aether_to_dart.rst} (100%) delete mode 100644 models/aether_lon-lat/aether_to_netcdf.nml rename models/aether_lon-lat/{netcdf_to_aether.f90 => dart_to_aether.f90} (100%) rename models/aether_lon-lat/{netcdf_to_aether.nml => dart_to_aether.nml} (100%) rename models/aether_lon-lat/{netcdf_to_aether.rst => dart_to_aether.rst} (100%) create mode 100644 models/aether_lon-lat/work/f10_7.cdl create mode 100644 models/aether_lon-lat/work/f10_7.nc create mode 100644 models/aether_lon-lat/work/input.nml create mode 100644 models/aether_lon-lat/work/out_restart_p_files.txt create mode 100644 models/aether_lon-lat/work/out_secondary_files.txt create mode 100755 models/aether_lon-lat/work/quickbuild.sh create mode 100644 models/aether_lon-lat/work/restart_p_files.txt create mode 100644 models/aether_lon-lat/work/secondary_files.txt diff --git a/models/aether_lon-lat/aether_to_netcdf.f90 b/models/aether_lon-lat/aether_to_dart.f90 similarity index 67% rename from models/aether_lon-lat/aether_to_netcdf.f90 rename to models/aether_lon-lat/aether_to_dart.f90 index 80905c30f4..0edee1a640 100644 --- a/models/aether_lon-lat/aether_to_netcdf.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -4,18 +4,18 @@ ! ! $Id$ -program gitm_blocks_to_netcdf +program aether_to_dart !---------------------------------------------------------------------- ! purpose: interface between the GITM model and DART ! -! method: Read gitm "restart" files of model state (multiple files, one -! block per gitm mpi task) +! method: Read aether "restart" files of model state (multiple files, one +! block per aether mpi task) ! Reform fields into a DART netcdf file ! -! USAGE: The gitm dirname is read from the gitm_in namelist -! -! gitm_blocks_to_netcdf +! USAGE: The aether dirname is read from the aether_in namelist +! +! aether_blocks_to_netcdf !---------------------------------------------------------------------- use types_mod, only : r8 @@ -37,17 +37,17 @@ program gitm_blocks_to_netcdf character(len=128), parameter :: revdate = "$Date$" character(len=512) :: string1, string2 -character(len=*), parameter :: program_name = 'gitm_blocks_to_netcdf' +character(len=*), parameter :: program_name = 'aether_blocks_to_netcdf' !----------------------------------------------------------------------- ! namelist parameters with default values. !----------------------------------------------------------------------- -character(len=256) :: gitm_restart_input_dirname = 'none' -character(len=256) :: gitm_to_netcdf_output_file = 'filter_input.nc' +character(len=256) :: aether_restart_input_dirname = 'none' +character(len=256) :: aether_to_dart_output_file = 'filter_input.nc' -namelist /gitm_blocks_to_netcdf_nml/ gitm_restart_input_dirname, & - gitm_to_netcdf_output_file +namelist /aether_to_dart/ aether_restart_input_dirname, & + aether_to_dart_output_file !---------------------------------------------------------------------- ! global storage @@ -63,26 +63,26 @@ program gitm_blocks_to_netcdf ! Read the namelist !---------------------------------------------------------------------- -call find_namelist_in_file("input.nml", "gitm_blocks_to_netcdf_nml", iunit) -read(iunit, nml = gitm_blocks_to_netcdf_nml, iostat = io) -call check_namelist_read(iunit, io, "gitm_blocks_to_netcdf_nml") ! closes, too. +call find_namelist_in_file("input.nml", "aether_blocks_to_netcdf_nml", iunit) +read(iunit, nml = aether_blocks_to_netcdf_nml, iostat = io) +call check_namelist_read(iunit, io, "aether_blocks_to_netcdf_nml") ! closes, too. !---------------------------------------------------------------------- ! Convert the files !---------------------------------------------------------------------- call error_handler(E_MSG, '', '') -write(string1,*) 'converting gitm restart files in directory ', & - "'"//trim(gitm_restart_input_dirname)//"'" -write(string2,*) ' to the NetCDF file ', "'"//trim(gitm_to_netcdf_output_file)//"'" +write(string1,*) 'converting aether restart files in directory ', & + "'"//trim(aether_restart_input_dirname)//"'" +write(string2,*) ' to the NetCDF file ', "'"//trim(aether_to_dart_output_file)//"'" call error_handler(E_MSG, program_name, string1, text2=string2) call error_handler(E_MSG, '', '') -call restart_files_to_netcdf(gitm_restart_input_dirname, gitm_to_netcdf_output_file) +call restart_files_to_netcdf(aether_restart_input_dirname, aether_to_dart_output_file) call error_handler(E_MSG, '', '') write(string1,*) 'Successfully converted the GITM restart files to ', & - "'"//trim(gitm_to_netcdf_output_file)//"'" + "'"//trim(aether_to_dart_output_file)//"'" call error_handler(E_MSG, program_name, string1) call error_handler(E_MSG, '', '') @@ -93,7 +93,7 @@ program gitm_blocks_to_netcdf ! end - close the log, etc call finalize_utilities() -end program gitm_blocks_to_netcdf +end program aether_to_dart ! ! $URL$ diff --git a/models/aether_lon-lat/aether_to_dart.nml b/models/aether_lon-lat/aether_to_dart.nml new file mode 100644 index 0000000000..1bc2feee3b --- /dev/null +++ b/models/aether_lon-lat/aether_to_dart.nml @@ -0,0 +1,5 @@ +&aether_to_dart_nml + aether_restart_input_dirname = 'none' + aether_to_dart_output_file = 'filter_input.nc' + / + diff --git a/models/aether_lon-lat/aether_to_netcdf.rst b/models/aether_lon-lat/aether_to_dart.rst similarity index 100% rename from models/aether_lon-lat/aether_to_netcdf.rst rename to models/aether_lon-lat/aether_to_dart.rst diff --git a/models/aether_lon-lat/aether_to_netcdf.nml b/models/aether_lon-lat/aether_to_netcdf.nml deleted file mode 100644 index c882761107..0000000000 --- a/models/aether_lon-lat/aether_to_netcdf.nml +++ /dev/null @@ -1,4 +0,0 @@ -&gitm_blocks_to_netcdf_nml - gitm_blocks_to_netcdf_input_file = 'filter_input.nc', - / - diff --git a/models/aether_lon-lat/netcdf_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90 similarity index 100% rename from models/aether_lon-lat/netcdf_to_aether.f90 rename to models/aether_lon-lat/dart_to_aether.f90 diff --git a/models/aether_lon-lat/netcdf_to_aether.nml b/models/aether_lon-lat/dart_to_aether.nml similarity index 100% rename from models/aether_lon-lat/netcdf_to_aether.nml rename to models/aether_lon-lat/dart_to_aether.nml diff --git a/models/aether_lon-lat/netcdf_to_aether.rst b/models/aether_lon-lat/dart_to_aether.rst similarity index 100% rename from models/aether_lon-lat/netcdf_to_aether.rst rename to models/aether_lon-lat/dart_to_aether.rst diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index d5f1ac3087..d2baaa48ec 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -152,9 +152,13 @@ module model_mod !------------------------------------------------------------------------------- ! define model parameters -! nilev is number of interaface levels +! nilev is number of interface levels ! nlev is number of midpoint levels +>>> +! TODO: Change names to Aether names, not TIEGCM names +>>> integer :: nilev, nlev, nlon, nlat +! TODO: levs -> alts? real(r8),dimension(:), allocatable :: lons, lats, levs, ilevs, plevs, pilevs ! levels + top level boundary condition for nlev. integer :: all_nlev @@ -209,8 +213,6 @@ module model_mod !=============================================================================== subroutine static_init_model() -!------------------------------------------------------------------------------- -! integer :: iunit, io @@ -222,20 +224,44 @@ subroutine static_init_model() module_initialized = .true. ! Read the namelist entry for model_mod from input.nml -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') - -if (do_nml_file()) write(nmlfileunit, nml=model_nml) -if (do_nml_term()) write( * , nml=model_nml) +call read_model_namelist() if (do_output()) then write( * ,*)'static_init_model: debug level is ',debug write(logfileunit,*)'static_init_model: debug level is ',debug endif +!--------------------------------------------------------------- +! get grid dimensions and values + +write(string1,'(3A)') "Now reading template file ",trim(template_filename),& + " for grid information" +call error_handler(E_MSG,routine,string1,source,revision,revdate) + +call get_grid_info_from_netcdf(template_filename, NgridLon, NgridLat, NgridAlt) -! Read in TIEGCM grid definition from TIEGCM restart file -call read_TIEGCM_definition(tiegcm_restart_file_name) +! TODO: replacing these with lons, lats, alts +allocate(LON(NgridLon)) +allocate(LAT(NgridLat)) +allocate(ALT(NgridAlt)) + +!--------------------------------------------------------------- +! get grid dimensions and values +call get_grid_from_netcdf(template_filename, LON, LAT, ALT) + +!--------------------------------------------------------------- + +! mass points at cell centers +call init_quad_interp(GRID_QUAD_IRREG_SPACED_REGULAR, nGridLon, nGridLat, & + QUAD_LOCATED_CELL_CENTERS, & + global=.false., spans_lon_zero=.false., pole_wrap=.false., & + interp_handle=quad_interp) + +call set_quad_coords(quad_interp, LON, LAT) + +if ( debug > 0 ) then + write(string1,'("grid: NgridLon, NgridLat, NgridAlt =",3(1x,i5))') NgridLon, NgridLat, NgridAlt + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif if ( estimate_f10_7 ) then call error_handler(E_MSG, 'f10_7 part of DART state', source) @@ -257,6 +283,1059 @@ subroutine static_init_model() end subroutine static_init_model +!================================================================== + +! Read the lon, lat, and alt arrays from the ncid + +subroutine get_grid_from_netcdf(template_filename, LON, LAT, ALT ) + +character(len=*), intent(in) :: template_filename +real(r8), intent(inout) :: LON(:) +real(r8), intent(inout) :: LAT(:) +real(r8), intent(inout) :: ALT(:) + +character(len=*), parameter :: routine = 'get_grid_from_netcdf' + +integer :: ncid + +ncid = nc_open_file_readonly(template_filename, routine) + +call nc_get_variable(ncid, LAT_VAR_NAME, LAT, routine) +call nc_get_variable(ncid, LON_VAR_NAME, LON, routine) +call nc_get_variable(ncid, ALT_VAR_NAME, ALT, routine) + +call nc_close_file(ncid) + +end subroutine get_grid_from_netcdf + +!================================================================= + +subroutine static_init_blocks(restart_dirname) + +character(len=*), intent(in) :: restart_dirname + +character(len=*), parameter :: routine = 'static_init_blocks' + +character(len=NF90_MAX_NAME) :: varname +integer :: iunit, io, ivar +!logical :: has_gitm_namelist + +call read_model_namelist() + +! 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) + +! Read the DART namelist for this model +call find_namelist_in_file('input.nml', 'gitm_blocks_nml', iunit) +read(iunit, nml = gitm_blocks_nml, iostat = io) +call check_namelist_read(iunit, io, 'gitm_blocks_nml') + +! Record the namelist values used for the run +if (do_nml_file()) write(nmlfileunit, nml=gitm_blocks_nml) +if (do_nml_term()) write( * , nml=gitm_blocks_nml) + +! Get the GITM variables in a restricted scope setting. + +nSpecies = get_nSpecies() +nSpeciesTotal = get_nSpeciesTotal() +nIons = get_nIons() +nSpeciesAll = get_nSpeciesAll() +nLonsPerBlock = get_nLonsPerBlock() +nLatsPerBlock = get_nLatsPerBlock() +nAltsPerBlock = get_nAltsPerBlock() + +!--------------------------------------------------------------- +! Set the time step ... causes gitm namelists to be read. +! Ensures model_advance_time is multiple of 'dynamics_timestep' + +call set_calendar_type( calendar ) ! comes from model_mod_nml + +!--------------------------------------------------------------- +! 1) get grid dimensions +! 2) allocate space for the grids +! 3) read them from the block restart files, could be stretched ... + +call get_grid_info_from_blocks(restart_dirname, NgridLon, NgridLat, NgridAlt, nBlocksLon, & + nBlocksLat, LatStart, LatEnd, LonStart) + +if( debug > 0 ) then + write(string1,*) 'grid dims are ',NgridLon,NgridLat,NgridAlt + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif + +! TODO; this is also done in gitm's static_init_model, which is not called by aether_to_dart, +! so it's not redundant. +allocate( LON( NgridLon )) +allocate( LAT( NgridLat )) +allocate( ALT( NgridAlt )) + +call get_grid_from_blocks(restart_dirname, nBlocksLon, nBlocksLat, & + nLonsPerBlock, nLatsPerBlock, nAltsPerBlock, LON, LAT, ALT ) + +! this is going to have to loop over all the blocks, both to get +! the data values and to get the full grid spacings. + +model_time = get_state_time(restart_dirname) + +if (do_output()) & + call print_time(model_time,'time in restart file '//trim(restart_dirname)//'/header.rst') +if (do_output()) & + call print_date(model_time,'date in restart file '//trim(restart_dirname)//'/header.rst') + +call verify_block_variables( gitm_block_variables, nfields ) + +do ivar = 1, nfields + + varname = trim(gitm_block_variables(ivar)) + gitmvar(ivar)%varname = varname + + ! This routine also checks to make sure user specified accurate GITM variables + call decode_gitm_indices( varname, & + gitmvar(ivar)%gitm_varname, & + gitmvar(ivar)%gitm_dim, & + gitmvar(ivar)%gitm_index, & + gitmvar(ivar)%long_name, & + gitmvar(ivar)%units) + if ( debug > 0 ) then + call print_gitmvar_info(ivar,routine) + endif +enddo + +if ( debug > 0 ) then + write(string1,'("grid: NgridLon, NgridLat, NgridAlt =",3(1x,i5))') NgridLon, NgridLat, NgridAlt + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif + +end subroutine static_init_blocks + +!================================================================== + +subroutine read_model_namelist() + +integer :: iunit, io + +! 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') + +! 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) + +end subroutine read_model_namelist + +!================================================================== + +!> Read the grid dimensions from the restart netcdf file. +!> KDR: I don't see a netcdf file. UAM.in is text and doesn't have any .nc file names in it. +!> +!> The file name comes from module storage ... namelist. + +subroutine get_grid_info_from_blocks(gitm_restart_dirname, NgridLon, NgridLat, & + NgridAlt, nBlocksLon, nBlocksLat, LatStart, LatEnd, LonStart) + +character(len=*), intent(in) :: gitm_restart_dirname +integer, intent(out) :: NgridLon ! Number of Longitude centers +integer, intent(out) :: NgridLat ! Number of Latitude centers +integer, intent(out) :: NgridAlt ! Number of Vertical grid centers +integer, intent(out) :: nBlocksLon, nBlocksLat +real(r8), intent(out) :: LatStart, LatEnd, LonStart + +character(len=*), parameter :: filename = 'UAM.in' + +character(len=100) :: cLine ! iCharLen_ == 100 +character(len=256) :: fileloc + +integer :: i, iunit, ios + +character(len=*), parameter :: routine = 'get_grid_info_from_blocks' + +! get the ball rolling ... + +nBlocksLon = 0 +nBlocksLat = 0 +LatStart = 0.0_r8 +LatEnd = 0.0_r8 +LonStart = 0.0_r8 + +write(fileloc,'(a,''/'',a)') trim(gitm_restart_dirname),trim(filename) + +if (debug > 4) then + write(string1,*) 'Now opening GITM restart file: ',trim(fileloc) + call error_handler(E_MSG,routine,string1,source,revision,revdate) +end if + + +iunit = open_file(trim(fileloc), action='read') + +UAMREAD : do i = 1, 1000000 + + read(iunit,'(a)',iostat=ios) cLine + + if (ios /= 0) then + ! If we get to the end of the file or hit a read error without + ! finding what we need, die. + write(string1,*) 'cannot find #GRID in ',trim(fileloc) + call error_handler(E_ERR,'get_grid_info_from_blocks',string1,source,revision,revdate) + endif + + if (cLine(1:5) .ne. "#GRID") cycle UAMREAD + + nBlocksLon = read_in_int( iunit,'NBlocksLon',trim(fileloc)) + nBlocksLat = read_in_int( iunit,'NBlocksLat',trim(fileloc)) + LatStart = read_in_real(iunit,'LatStart', trim(fileloc)) + LatEnd = read_in_real(iunit,'LatEnd', trim(fileloc)) + LonStart = read_in_real(iunit,'LonStart', trim(fileloc)) + + exit UAMREAD + +enddo UAMREAD + +if (debug > 4) then + write(string1,*) 'Successfully read GITM restart file:',trim(fileloc) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nLonsPerBlock:',nLonsPerBlock + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nLatsPerBlock:',nLatsPerBlock + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nBlocksLon:',nBlocksLon + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nBlocksLat:',nBlocksLat + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' LatStart:',LatStart + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' LatEnd:',LatEnd + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' LonStart:',LonStart + call error_handler(E_MSG,routine,string1,source,revision,revdate) +end if + +call close_file(iunit) + +NgridLon = nBlocksLon * nLonsPerBlock +NgridLat = nBlocksLat * nLatsPerBlock +NgridAlt = nAltsPerBlock + +write(string1,*) 'NgridLon = ', NgridLon +call error_handler(E_MSG,routine,string1,source,revision,revdate) +write(string1,*) 'NgridLat = ', NgridLat +call error_handler(E_MSG,routine,string1,source,revision,revdate) +write(string1,*) 'NgridAlt = ', NgridAlt +call error_handler(E_MSG,routine,string1,source,revision,revdate) + +end subroutine get_grid_info_from_blocks + +!================================================================== + +! open enough of the restart files to read in the lon, lat, alt arrays + +subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, & + nLonsPerBlock, nLatsPerBlock, nAltsPerBlock, & + LON, LAT, ALT ) + +character(len=*), intent(in) :: dirname +integer, intent(in) :: nBlocksLon ! Number of Longitude blocks +integer, intent(in) :: nBlocksLat ! Number of Latitude blocks +integer, intent(in) :: nLonsPerBlock ! Number of Longitude centers per block +integer, intent(in) :: nLatsPerBlock ! Number of Latitude centers per block +integer, intent(in) :: nAltsPerBlock ! Number of Vertical grid centers + +real(r8), dimension( : ), intent(inout) :: LON, LAT, ALT + +integer :: ios, nb, offset, iunit, nboff +character(len=256) :: filename +real(r8), allocatable :: temp(:) + +character(len=*), parameter :: routine = 'get_grid_from_blocks' + +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +allocate(temp(1-nGhost:max(nLonsPerBlock,nLatsPerBlock,nAltsPerBlock)+nGhost)) + +! go across the south-most block row picking up all longitudes +do nb = 1, nBlocksLon + + iunit = open_block_file(dirname, nb, 'read', filename) + + read(iunit,iostat=ios) temp(1-nGhost:nLonsPerBlock+nGhost) + if ( ios /= 0 ) then + print *,'size:',size(temp(1-nGhost:nLonsPerBlock+nGhost)) + print *,'IO error code:',ios + write(string1,*)'ERROR reading file ', trim(filename) + write(string2,*)'longitude block ',nb,' of ',nBlocksLon + call error_handler(E_ERR,'get_grid',string1, & + source,revision,revdate,text2=string2) + endif + + offset = (nLonsPerBlock * (nb - 1)) + LON(offset+1:offset+nLonsPerBlock) = temp(1:nLonsPerBlock) + + call close_file(iunit) +enddo + +! go up west-most block row picking up all latitudes +do nb = 1, nBlocksLat + + nboff = ((nb - 1) * nBlocksLon) + 1 + iunit = open_block_file(dirname, nboff, 'read', filename) + + ! get past lon array and read in lats + read(iunit) temp(1-nGhost:nLonsPerBlock+nGhost) + + read(iunit,iostat=ios) temp(1-nGhost:nLatsPerBlock+nGhost) + if ( ios /= 0 ) then + write(string1,*)'ERROR reading file ', trim(filename) + write(string2,*)'latitude block ',nb,' of ',nBlocksLat + call error_handler(E_ERR,'get_grid',string1, & + source,revision,revdate,text2=string2) + endif + + offset = (nLatsPerBlock * (nb - 1)) + LAT(offset+1:offset+nLatsPerBlock) = temp(1:nLatsPerBlock) + + call close_file(iunit) +enddo + +! this code assumes UseTopography is false - that all columns share +! the same altitude array, so we can read it from the first block. +! if this is not the case, this code has to change. + +iunit = open_block_file(dirname, 1, 'read', filename) + +! get past lon and lat arrays and read in alt array +read(iunit) temp(1-nGhost:nLonsPerBlock+nGhost) +read(iunit) temp(1-nGhost:nLatsPerBlock+nGhost) +read(iunit) temp(1-nGhost:nAltsPerBlock+nGhost) + +ALT(1:nAltsPerBlock) = temp(1:nAltsPerBlock) + +call close_file(iunit) + +deallocate(temp) + +! convert from radians into degrees +LON = LON * rad2deg +LAT = LAT * rad2deg + +if (debug > 4) then + print *, 'All LONs ', LON + print *, 'All LATs ', LAT + print *, 'All ALTs ', ALT +endif + +if ( debug > 1 ) then ! A little sanity check + write(string1,*)'LON range ',minval(LON),maxval(LON) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*)'LAT range ',minval(LAT),maxval(LAT) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*)'ALT range ',minval(ALT),maxval(ALT) + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif + +end subroutine get_grid_from_blocks + +!================================================================= + +subroutine verify_block_variables( variable_array, ngood) + +character(len=*), dimension(:), intent(in) :: variable_array +integer, intent(out) :: ngood + +integer :: nrows, i +character(len=NF90_MAX_NAME) :: varname + +character(len=*), parameter :: routine = 'verify_state_variables' + +nrows = size(variable_array,1) + +ngood = 0 +MyLoop : do i = 1, nrows + + varname = variable_array(i) + + if ( varname == ' ') exit MyLoop ! Found end of list. + + ngood = ngood + 1 +enddo MyLoop + +if (ngood == nrows) then + string1 = 'WARNING: There is a possibility you need to increase ''max_state_variables''' + write(string2,'(''WARNING: you have specified at least '',i4,'' perhaps more.'')')ngood + call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2) +endif + +end subroutine verify_block_variables + +!================================================================== +!> Converts gitm restart files to a netCDF file +!> +!> This routine needs: +!> +!> 1. A base dirname for the restart files (restart_dirname). +!> they will have the format 'dirname/bNNNN.rst' where NNNN has +!> leading 0s and is the block number. Blocks start in the +!> southwest corner of the lat/lon grid and go east first, +!> then to the west end of the next row north and end in the northeast corner. +!> The other info is in 'dirname/header.rst' +!> +!> 2. The name of the output file to store the netCDF variables +!> (netcdf_output_file) +!> +!> In the process, the routine will find: +!> +!> 1. The overall grid size, lon/lat/alt when you've read in all +!> the blocks. (nGridLon, nGridLat, nGridAlt) +!> +!> 2. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) +!> +!> 3. The number of lon/lats in a single grid block (nLonsPerBlock, +!> nLatsPerBlock, nAltsPerBlock) +!> +!> 4. The number of neutral species (and probably a mapping between +!> the species number and the variable name) (nSpeciesTotal, nSpecies) +!> +!> 5. The number of ion species (ditto - numbers <-> names) (nIons) +!> +!> We assume that the 'UseTopography' flag is false - that all columns +!> have the same altitude arrays. This is true on earth but not on +!> other planets. +!> +!> In addition to reading in the state data, it fills Longitude, +!> Latitude, and Altitude arrays with the grid spacing. This grid +!> is orthogonal and rectangular but can have irregular spacing along +!> any or all of the three dimensions. + +subroutine restart_files_to_netcdf(restart_dirname,netcdf_output_file) + +character(len=*), intent(in) :: restart_dirname +character(len=*), intent(in) :: netcdf_output_file + +integer :: ncid + +character(len=*), parameter :: routine = 'restart_files_to_netcdf' + +if (module_initialized ) then + write(string1,*)'The gitm mod was already initialized but ',trim(routine),& + ' uses a separate initialization procedure' + call error_handler(E_ERR,routine,string1,source,revision,revdate) +end if + +call static_init_blocks(restart_dirname) + +ncid = nc_create_file(netcdf_output_file) + +call add_nc_definitions(ncid) + +call get_data(restart_dirname, ncid, define=.true.) + +call nc_end_define_mode(ncid) + +! TODO: This has not been activated because the functionality is in TIEGCM's nc_write_model_atts +! but maybe it shouldn't be. +! call add_nc_dimvars(ncid) + +call get_data(restart_dirname, ncid, define=.false.) + +call print_time(model_time) + +call write_model_time(ncid, model_time) + +call nc_close_file(ncid) + +end subroutine restart_files_to_netcdf + +!================================================================== + +subroutine add_nc_definitions(ncid) + +integer, intent(in) :: ncid + +call nc_add_global_attribute(ncid, 'model', 'gitm') + +!------------------------------------------------------------------------------- +! Determine shape of most important namelist +!------------------------------------------------------------------------------- +! +!call find_textfile_dims('gitm_vars.nml', nlines, linelen) +!if (nlines > 0) then +! has_gitm_namelist = .true. +! +! allocate(textblock(nlines)) +! textblock = '' +! +! call nc_define_dimension(ncid, 'nlines', nlines) +! call nc_define_dimension(ncid, 'linelen', linelen) +! call nc_define_character_variable(ncid, 'gitm_in', (/ 'nlines ', 'linelen' /)) +! call nc_add_attribute_to_variable(ncid, 'gitm_in', 'long_name', 'contents of gitm_in namelist') +! +!else +! has_gitm_namelist = .false. +!endif +! +!---------------------------------------------------------------------------- +! output only grid info - state vars will be written by other non-model_mod code +!---------------------------------------------------------------------------- + +call nc_define_dimension(ncid, LON_DIM_NAME, NgridLon) +call nc_define_dimension(ncid, LAT_DIM_NAME, NgridLat) +call nc_define_dimension(ncid, ALT_DIM_NAME, NgridAlt) +call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? + +!---------------------------------------------------------------------------- +! Create the (empty) Coordinate Variables and the Attributes +!---------------------------------------------------------------------------- + +! Grid Longitudes +call nc_define_double_variable(ncid, LON_VAR_NAME, (/ LON_DIM_NAME /) ) +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'type', 'x1d') +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'long_name', 'grid longitudes') +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'cartesian_axis', 'X') +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'units', 'degrees_east') +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'valid_range', (/ 0.0_r8, 360.0_r8 /) ) + +! Grid Latitudes +call nc_define_double_variable(ncid, LAT_VAR_NAME, (/ LAT_DIM_NAME /) ) +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'type', 'y1d') +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'long_name', 'grid latitudes') +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'cartesian_axis', 'Y') +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'units', 'degrees_north') +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'valid_range', (/ -90.0_r8, 90.0_r8 /) ) + +! Grid Altitudes +call nc_define_double_variable(ncid, ALT_VAR_NAME, (/ ALT_DIM_NAME /) ) +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'type', 'z1d') +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'long_name', 'grid altitudes') +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'cartesian_axis', 'Z') +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'units', 'meters') +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'positive', 'up') + +! Grid wavelengths +call nc_define_double_variable(ncid, 'WL', (/ 'WL' /) ) +call nc_add_attribute_to_variable(ncid, 'WL', 'type', 'x1d') +call nc_add_attribute_to_variable(ncid, 'WL', 'long_name', 'grid wavelengths') +call nc_add_attribute_to_variable(ncid, 'WL', 'cartesian_axis', 'X') +call nc_add_attribute_to_variable(ncid, 'WL', 'units', 'wavelength_index') +call nc_add_attribute_to_variable(ncid, 'WL', 'valid_range', (/ 0.9_r8, 38.1_r8 /) ) + +end subroutine add_nc_definitions + +!================================================================= +! open all restart files and read in the requested data item + +subroutine get_data(dirname, ncid, define) + +character(len=*), intent(in) :: dirname +integer, intent(in) :: ncid +logical, intent(in) :: define + +integer :: ibLoop, jbLoop +integer :: ib, jb, nb, iunit + +character(len=256) :: filename + +! get the dirname, construct the filenames inside open_block_file + +if (define) then + ! if define, run one block. + ! the read_data_from_block call defines the variables in the netCDF file. + ibLoop = 1 + jbLoop = 1 +else + ! if not define, run all blocks. + ! the read_data_from_block call adds the (ib,jb) block to a netCDF variable + ! in order to make a file containing the data for all the blocks. + ibLoop = nBlocksLon + jbLoop = nBlocksLat +end if + +do jb = 1, jbLoop + do ib = 1, ibLoop + nb = (jb-1) * nBlocksLon + ib + + iunit = open_block_file(dirname, nb, 'read', filename) + + call read_data_from_block(iunit, ib, jb, ncid, define) + + call close_file(iunit) + enddo +enddo + +end subroutine get_data + +!================================================================== + +!> open all restart files and read in the requested data items +!> +!> This is a two-pass method: first run through to define the NC variables +!> (define = .true.), then run again to write the data to the NC file +!> (define = .false.) + +subroutine read_data_from_block(iunit, ib, jb, ncid, define) + +integer, intent(in) :: iunit +integer, intent(in) :: ib, jb +integer, intent(in) :: ncid +logical, intent(in) :: define + +real(r8), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:), temp4d(:,:,:,:) +real(r8), allocatable :: alt1d(:), density_ion_e(:,:,:) +real(r8) :: temp0d !Alex: single parameter has "zero dimensions" +integer :: i, j, inum, maxsize, ivals(NSpeciesTotal) +integer :: block(2) = 0 + +logical :: no_idensity + +character(len=*), parameter :: routine = 'read_data_from_block' + +block(1) = ib +block(2) = jb + +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +allocate(temp1d(1-nGhost:max(nLonsPerBlock,nLatsPerBlock,nAltsPerBlock)+nGhost)) +! treat alt specially since we want to derive TEC here +allocate( alt1d(1-nGhost:max(nLonsPerBlock,nLatsPerBlock,nAltsPerBlock)+nGhost)) + +! temp array large enough to hold any 2D field +allocate(temp2d(1-nGhost:nLonsPerBlock+nGhost, & + 1-nGhost:nLatsPerBlock+nGhost)) + +! temp array large enough to hold 1 species, temperature, etc +allocate(temp3d(1-nGhost:nLonsPerBlock+nGhost, & + 1-nGhost:nLatsPerBlock+nGhost, & + 1-nGhost:nAltsPerBlock+nGhost)) + +! save density_ion_e to compute TEC +allocate(density_ion_e(1-nGhost:nLonsPerBlock+nGhost, & + 1-nGhost:nLatsPerBlock+nGhost, & + 1-nGhost:nAltsPerBlock+nGhost)) + +! temp array large enough to hold velocity vect, etc +maxsize = max(3, nSpecies) +allocate(temp4d(1-nGhost:nLonsPerBlock+nGhost, & + 1-nGhost:nLatsPerBlock+nGhost, & + 1-nGhost:nAltsPerBlock+nGhost, maxsize)) + +! get past lon and lat arrays and read in alt array +read(iunit) temp1d(1-nGhost:nLonsPerBlock+nGhost) +read(iunit) temp1d(1-nGhost:nLatsPerBlock+nGhost) +! save the alt1d for later TEC computation +read(iunit) alt1d(1-nGhost:nAltsPerBlock+nGhost) + +! Read the index from the first species +call get_index_from_gitm_varname('NDensityS', inum, ivals) + +if (inum > 0) then + ! if i equals ival, use the data from the state vect + ! otherwise read/write what's in the input file + j = 1 + do i = 1, nSpeciesTotal + if (debug > 80) then + write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading species ',i,' of ',nSpeciesTotal, & + ' for block (',ib,',',jb,')' + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + read(iunit) temp3d + if (j <= inum) then + if (i == gitmvar(ivals(j))%gitm_index) then + call unpack_data(temp3d, ivals(j), block, ncid, define) + j = j + 1 + endif + endif + enddo +else + if (debug > 80) then + write(string1,'(A)') 'Not writing the NDensityS variables to file' + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + ! nothing at all from this variable in the state vector. + ! copy all data over from the input file to output file + do i = 1, nSpeciesTotal + read(iunit) temp3d + enddo +endif + +call get_index_from_gitm_varname('IDensityS', inum, ivals) + +! assume we could not find the electron density for VTEC calculations +no_idensity = .true. + +if (inum > 0) then + ! one or more items in the state vector need to replace the + ! data in the output file. loop over the index list in order. + j = 1 + do i = 1, nIons + if (debug > 80) then + write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & + ' for block (',ib,',',jb,')' + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + read(iunit) temp3d + if (j <= inum) then + if (i == gitmvar(ivals(j))%gitm_index) then + ! ie_, the gitm index for electron density, comes from ModEarth + if (gitmvar(ivals(j))%gitm_index == ie_) then + ! save the electron density for TEC computation + density_ion_e(:,:,:) = temp3d(:,:,:) + no_idensity = .false. + end if + ! read from input but write from state vector + call unpack_data(temp3d, ivals(j), block, ncid, define) + j = j + 1 + endif + endif + enddo +else + ! nothing at all from this variable in the state vector. + ! read past this variable + if (debug > 80) then + write(string1,'(A)') 'Not writing the IDensityS variables to file' + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + do i = 1, nIons + read(iunit) temp3d + enddo +endif + +read(iunit) temp3d +call get_index_from_gitm_varname('Temperature', inum, ivals) + +if (inum > 0) then + call unpack_data(temp3d, ivals(1), block, ncid, define) +endif + +read(iunit) temp3d +call get_index_from_gitm_varname('ITemperature', inum, ivals) +if (inum > 0) then + call unpack_data(temp3d, ivals(1), block, ncid, define) +endif + +read(iunit) temp3d +call get_index_from_gitm_varname('eTemperature', inum, ivals) +if (inum > 0) then + call unpack_data(temp3d, ivals(1), block, ncid, define) +endif + +read(iunit) temp4d(:,:,:,1:3) +call get_index_from_gitm_varname('Velocity', inum, ivals) +if (inum > 0) then + ! copy out any requested bits into state vector + j = 1 + do i = 1, 3 + if (j <= inum) then + if (i == gitmvar(ivals(j))%gitm_index) then + temp3d = temp4d(:,:,:,i) + call unpack_data(temp3d, ivals(j), block, ncid, define) + j = j + 1 + endif + endif + enddo +endif + +read(iunit) temp4d(:,:,:,1:3) +call get_index_from_gitm_varname('IVelocity', inum, ivals) +if (inum > 0) then + ! copy out any requested bits into state vector + j = 1 + do i = 1, 3 + if (j <= inum) then + if (i == gitmvar(ivals(j))%gitm_index) then + ! read from input but write from state vector + temp3d = temp4d(:,:,:,i) + call unpack_data(temp3d, ivals(j), block, ncid, define) + j = j + 1 + endif + endif + enddo +endif + +!print *, 'reading in temp4d for vvel' +read(iunit) temp4d(:,:,:,1:nSpecies) +call get_index_from_gitm_varname('VerticalVelocity', inum, ivals) +if (inum > 0) then + ! copy out any requested bits into state vector + j = 1 + do i = 1, nSpecies + if (j <= inum) then + if (i == gitmvar(ivals(j))%gitm_index) then + temp3d = temp4d(:,:,:,i) + call unpack_data(temp3d, ivals(j), block, ncid, define) + j = j + 1 + endif + endif + enddo +endif + +! add the VTEC as an extended-state variable +! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program +call get_index_from_gitm_varname('TEC', inum, ivals) + +if (inum > 0 .and. no_idensity) then + write(string1,*) 'Cannot compute the VTEC without the electron density' + call error_handler(E_ERR,routine,string1,source,revision,revdate) +end if + +if (inum > 0) then + if (.not. define) then + temp2d = 0._r8 + ! comptue the TEC integral + do i =1,nAltsPerBlock-1 ! approximate the integral over the altitude as a sum of trapezoids + ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 + temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 + end do + ! convert temp2d to TEC units + temp2d = temp2d/1e16_r8 + end if + call unpack_data2d(temp2d, ivals(1), block, ncid, define) +end if + +!alex begin +read(iunit) temp0d +!gitm_index = get_index_start(domain_id, 'VerticalVelocity') +call get_index_from_gitm_varname('f107', inum, ivals) +if (inum > 0) then + call unpack_data0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine +endif + +read(iunit) temp3d +call get_index_from_gitm_varname('Rho', inum, ivals) +if (inum > 0) then + call unpack_data(temp3d, ivals(1), block, ncid, define) +endif +!alex end + +!print *, 'calling dealloc' +deallocate(temp1d, temp2d, temp3d, temp4d) +deallocate(alt1d, density_ion_e) + +end subroutine read_data_from_block + +!================================================================= +! Determine where any data from a given gitm_varname lies in the +! DART state vector. + +subroutine get_index_from_gitm_varname(gitm_varname, inum, ivals) + +character(len=*), intent(in) :: gitm_varname +integer, intent(out) :: inum, ivals(:) + +integer :: gindex(nfields) +integer :: i, limit + +inum = 0 +limit = size(ivals) + +! GITM handles variables in a way that might seem strange at first. +! It uses the same name but multiple indices. For example, the U, V, +! and W components of wind are index = 1, 2, 3 for the variable velocity. +! This is why the code below looks the way it does. +FieldLoop : do i=1,nfields + if (gitmvar(i)%gitm_varname /= gitm_varname) cycle FieldLoop + inum = inum + 1 + if (inum > limit) then + write(string1,*) 'found too many matches, ivals needs to be larger than ', limit + call error_handler(E_ERR,'get_index_from_gitm_varname',string1,source,revision,revdate) + endif + ! i is index into gitmvar array - the order of the fields in the sv + ! gitm_index is index into the specific variable in the gitm restarts + ivals(inum) = i + gindex(inum) = gitmvar(i)%gitm_index +enddo FieldLoop + +!if (inum > 0) then +! print *, 'before sort, inum: ', inum +! print *, 'before sort, gindex: ', gindex(1:inum) +! print *, 'before sort, ivals: ', ivals(1:inum) +!endif + +! return the vals sorted by gitm_index order if more than 1 +if (inum > 1) call sortindexlist(gindex, ivals, inum) + +!if (inum > 0) then +! print *, 'after sort, inum: ', inum +! print *, 'after sort, gindex: ', gindex(1:inum) +! print *, 'after sort, ivals: ', ivals(1:inum) +!endif + +end subroutine get_index_from_gitm_varname + +!================================================================== + + +!> put the f107 estimate (a scalar, hence 0d) into the state vector. +!> Written specifically +!> for f107 since f107 is the same for all blocks. So what it does +!> is take f107 from the first block (block = 0) and disregard +!> f107 values from all other blocks (hopefully they are the same). +!> written by alex + +subroutine unpack_data0d(data0d, ivar, ncid, define) + +real(r8), intent(in) :: data0d +integer, intent(in) :: ivar ! index into state structure +integer, intent(in) :: ncid +logical, intent(in) :: define + + +character(len=*), parameter :: routine = 'unpack_data0d' + +if (define) then + + if (debug > 10) then + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + + call nc_define_double_scalar(ncid, gitmvar(ivar)%varname) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) + +else + + call nc_put_variable(ncid, gitmvar(ivar)%varname, data0d, context=routine) + +end if + +end subroutine unpack_data0d + +!================================================================== + +! put the requested data into a netcdf variable + +subroutine unpack_data2d(data2d, ivar, block, ncid, define) + +real(r8), intent(in) :: data2d(1-nGhost:nLonsPerBlock+nGhost, & + 1-nGhost:nLatsPerBlock+nGhost) + +integer, intent(in) :: ivar ! variable index +integer, intent(in) :: block(2) +integer, intent(in) :: ncid +logical, intent(in) :: define + +integer :: ib, jb +integer :: starts(2) +character(len=*), parameter :: routine = 'unpack_data2d' + +if (define) then + + if (debug > 10) then + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + + call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME /) ) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) + !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) + +else + ib = block(1) + jb = block(2) + + ! to compute the start, consider (ib-1)*nLonsPerBlock+1 + starts(1) = (ib-1)*nLonsPerBlock+1 + starts(2) = (jb-1)*nLatsPerBlock+1 + + call nc_put_variable(ncid, gitmvar(ivar)%varname, & + data2d(1:nLonsPerBlock,1:nLatsPerBlock), & + context=routine, nc_start=starts, & + nc_count=(/nLonsPerBlock,nLatsPerBlock/)) +end if + +end subroutine unpack_data2d + +!================================================================== + +! put the requested data into a netcdf variable + +subroutine unpack_data(data3d, ivar, block, ncid, define) + +real(r8), intent(in) :: data3d(1-nGhost:nLonsPerBlock+nGhost, & + 1-nGhost:nLatsPerBlock+nGhost, & + 1-nGhost:nAltsPerBlock+nGhost) + +integer, intent(in) :: ivar ! variable index +integer, intent(in) :: block(2) +integer, intent(in) :: ncid +logical, intent(in) :: define + +integer :: ib, jb +integer :: starts(3) +character(len=*), parameter :: routine = 'unpack_data' + +if (define) then + + if (debug > 10) then + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + + call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME, ALT_DIM_NAME /) ) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) + !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) + call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) + +else + + ib = block(1) + jb = block(2) + + ! to compute the start, consider (ib-1)*nLonsPerBlock+1 + starts(1) = (ib-1)*nLonsPerBlock+1 + starts(2) = (jb-1)*nLatsPerBlock+1 + starts(3) = 1 + + call nc_put_variable(ncid, gitmvar(ivar)%varname, & + data3d(1:nLonsPerBlock,1:nLatsPerBlock,1:nAltsPerBlock), & + context=routine, nc_start=starts, & + nc_count=(/nLonsPerBlock,nLatsPerBlock,nAltsPerBlock/)) +end if + +end subroutine unpack_data + + +!================================================================= +!> sort list x into order based on values in list. +!> should only be called on short ( < hundreds) of values or will be slow +!> @todo FIXME this should be using the sort module routine instead. + +subroutine sortindexlist(list, x, inum) + +integer, intent(inout) :: list(:) +integer, intent(inout) :: x(:) +integer, intent(in) :: inum + +integer :: tmp +integer :: j, k + +! DO A N^2 SORT - only use for short lists +do j = 1, inum - 1 + do k = j + 1, inum + ! if list() is in wrong order, exchange both list items and + ! items in x array. + if(list(j) .gt. list(k)) then + tmp = list(k) + list(k) = list(j) + list(j) = tmp + tmp = x(k) + x(k) = x(j) + x(j) = tmp + end if + end do +end do +end subroutine sortindexlist + !------------------------------------------------------------------------------- @@ -271,10 +1350,7 @@ function get_model_size() end function get_model_size - - -!------------------------------------------------------------------------------- - +!================================================================== subroutine model_interpolate(state_handle, ens_size, location, iqty, obs_val, istatus) ! Given a location, and a model state variable qty, @@ -463,8 +1539,7 @@ function shortest_time_between_assimilations() end function shortest_time_between_assimilations -!------------------------------------------------------------------------------- - +!================================================================== subroutine get_state_meta_data(index_in, location, var_qty) ! Given an integer index into the state vector, returns the @@ -512,17 +1587,15 @@ subroutine get_state_meta_data(index_in, location, var_qty) end subroutine get_state_meta_data - -!------------------------------------------------------------------------------- - +!================================================================== subroutine end_model() ! Does any shutdown and clean-up needed for model. end subroutine end_model +!================================================================== -!------------------------------------------------------------------------------- ! Writes the model-specific attributes to a netCDF file. subroutine nc_write_model_atts( ncid, dom_id ) @@ -586,6 +1659,35 @@ subroutine nc_write_model_atts( ncid, dom_id ) ! Write variables !------------------------------------------------------------------------------- +! TODO: Should nc_write_model_atts write dimension contents, not just atts? +! Gitm had a separate routine for filling the dimensions: +! - - - - - - - - - - - +! subroutine add_nc_dimvars(ncid) +! +! integer, intent(in) :: ncid +! +! !---------------------------------------------------------------------------- +! ! Fill the coordinate variables +! !---------------------------------------------------------------------------- +! +! call nc_put_variable(ncid, LON_VAR_NAME, LON) +! call nc_put_variable(ncid, LAT_VAR_NAME, LAT) +! call nc_put_variable(ncid, ALT_VAR_NAME, ALT) +! ! what about WL? +! +! !if (has_gitm_namelist) then +! ! call file_to_text('gitm_vars.nml', textblock) +! ! call nc_put_variable(ncid, 'gitm_in', textblock) +! ! deallocate(textblock) +! !endif +! +! !------------------------------------------------------------------------------- +! ! Flush the buffer and leave netCDF file open +! !------------------------------------------------------------------------------- +! call nc_synchronize_file(ncid) +! +! end subroutine add_nc_dimvars +! - - - - - - - - - - - ! Fill in the coordinate variables ! longitude - TIEGCM uses values +/- 180, DART uses values [0,360] @@ -603,8 +1705,8 @@ subroutine nc_write_model_atts( ncid, dom_id ) end subroutine nc_write_model_atts +!================================================================== -!------------------------------------------------------------------------------- ! Vertical localization is done only in height (ZG). ! obs vertical location is given in height (model_interpolate). ! state vertical location is given in height. @@ -669,8 +1771,7 @@ subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & end subroutine get_close_state - -!------------------------------------------------------------------------------- +!================================================================== subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, & which_vert, istatus) @@ -711,7 +1812,8 @@ subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, & end subroutine convert_vertical_obs -!------------------------------------------------------------------------------- +!================================================================== + subroutine convert_vertical_state(state_handle, num, locs, loc_qtys, loc_indx, & which_vert, istatus) @@ -899,7 +2001,11 @@ subroutine read_TIEGCM_definition(file_name) end subroutine read_TIEGCM_definition -!------------------------------------------------------------------------------- +!================================================================== + +! TODO: this TIEGCM (generic DART subr?) is kept in preference to gitm's set_gitm_variable_info, +! but we need to check the functionality, esp. the domains at the end. + ! Fill up the variable_table from the namelist item 'variables' ! The namelist item variables is where a user specifies ! which variables they want in the DART state: @@ -934,6 +2040,7 @@ subroutine verify_variables() ! Column 6 is whether or not the variable should be updated in the restart file. nfields = 0 +! TODO: TIEGCM uses 3 domains. Aeither may need only 1: nfields_restart = 0 nfields_secondary = 0 nfields_constructed = 0 @@ -968,6 +2075,13 @@ subroutine verify_variables() call error_handler(E_ERR,'get_variables_in_domain',string1, & source,revision,revdate,text2=string2,text3=string3) endif +! TODO; Modify this gitm error check for this routine? +! ! Make sure DART kind is valid +! +! 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 nfields=nfields+1 if (variable_table(i,VT_ORIGININDX) == 'RESTART') nfields_restart = nfields_restart+1 @@ -998,6 +2112,18 @@ subroutine verify_variables() if (nfields_secondary == 0) call error_handler(E_ERR, 'ZG is required in &model_nml::variables', source) +! TODO: TIEGCM uses 3 domains, so this section may need to be modified to look more like gitm's: +! ! gitm only has a single domain (only a single grid, no nests or multiple grids) +! +! domain_id = add_domain(template_filename, nfields, var_names, kind_list, & +! clamp_vals, update_list) +! !domain_id = add_domain(nfields, var_names, kind_list, & +! ! clamp_vals, update_list) +! +! if (debug > 1) call state_structure_info(domain_id) +! +! end subroutine set_gitm_variable_info + call load_up_state_structure_from_file(tiegcm_restart_file_name, nfields_restart, 'RESTART', RESTART_DOM) call load_up_state_structure_from_file(tiegcm_secondary_file_name, nfields_secondary, 'SECONDARY', SECONDARY_DOM) @@ -1017,7 +2143,8 @@ subroutine verify_variables() end subroutine verify_variables -!------------------------------------------------------------------------------- +!================================================================== + ! Adds a domain to the state structure from a netcdf file ! Called from verify_variables subroutine load_up_state_structure_from_file(filename, nvar, domain_name, domain_num) @@ -1068,7 +2195,8 @@ subroutine load_up_state_structure_from_file(filename, nvar, domain_name, domain deallocate(var_names, kind_list, clamp_vals, update_list) end subroutine load_up_state_structure_from_file -!------------------------------------------------------------------------------- + +!================================================================== subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) ! @@ -1177,8 +2305,7 @@ subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) end subroutine extrapolate_vtec - -!------------------------------------------------------------------------------- +!================================================================== subroutine vert_interp(state_handle, n, dom_id, var_id, lon_index, lat_index, height, iqty, & val, istatus) @@ -1220,7 +2347,8 @@ subroutine vert_interp(state_handle, n, dom_id, var_id, lon_index, lat_index, he end subroutine vert_interp -!------------------------------------------------------------------------------- +!================================================================== + subroutine find_qty_in_state(iqty, which_dom, var_id) ! Returns the variable id for a given DART qty ! Will return X rather than X_MN variable. @@ -1266,7 +2394,8 @@ subroutine find_qty_in_state(iqty, which_dom, var_id) end subroutine find_qty_in_state -!------------------------------------------------------------------------------- +!================================================================== + ! find enclosing lon indices ! Compute bracketing lon indices: ! TIEGCM [-180 175] DART [180, 185, ..., 355, 0, 5, ..., 175] @@ -1293,7 +2422,8 @@ subroutine compute_bracketing_lon_indices(lon, idx_below, idx_above, fraction) end subroutine compute_bracketing_lon_indices -!------------------------------------------------------------------------------- +!================================================================== + ! on ilev subroutine vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pressure, & dom_id, var_id, val, istatus) @@ -1393,7 +2523,8 @@ subroutine vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pr end subroutine vert_interp_ilev -!------------------------------------------------------------------------------- +!================================================================== + ! on lev subroutine vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & dom_id, var_id, val, istatus) @@ -1522,7 +2653,8 @@ subroutine vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pre end subroutine vert_interp_lev -!------------------------------------------------------------------------------- +!================================================================== + ! Compute neighboring lat rows: TIEGCM [-87.5, 87.5] DART [-90, 90] ! Poles >|87.5| set to |87.5| subroutine compute_bracketing_lat_indices(lat, idx_below, idx_above, fraction) diff --git a/models/aether_lon-lat/work/f10_7.cdl b/models/aether_lon-lat/work/f10_7.cdl new file mode 100644 index 0000000000..a3c55e4583 --- /dev/null +++ b/models/aether_lon-lat/work/f10_7.cdl @@ -0,0 +1,10 @@ +netcdf f10_7 { // example f10.7 netcdf file for DART +dimensions: + parameter = 1 ; +variables: + double f10_7(parameter) ; +// global attributes + :title = "example f10.7 netcdf file for DART" ; +data: + f10_7 = 70; +} diff --git a/models/aether_lon-lat/work/f10_7.nc b/models/aether_lon-lat/work/f10_7.nc new file mode 100644 index 0000000000000000000000000000000000000000..88497c975d19fc53cb25b8422bc697e6db60a9fd GIT binary patch literal 156 zcmZ>EabskF04^W}VsjQG7A5AUmZTOz#6e;_P&w9;%#xf`h&U6FQcA5z%q_@CRY)^5 z&@)%aOD#!GNmEG61c~GqDY!TWg@6@v!}J5y#hXL)!|a9d7#P@q3=SZk;t<#X76Skf CHx*p~ literal 0 HcmV?d00001 diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml new file mode 100644 index 0000000000..f81f02eee2 --- /dev/null +++ b/models/aether_lon-lat/work/input.nml @@ -0,0 +1,375 @@ +&quality_control_nml +/ + +&state_vector_io_nml + / + +&perfect_model_obs_nml + read_input_state_from_file = .true. + single_file_in = .false. + input_state_files = 'wrfinput_d01' + init_time_days = -1 + init_time_seconds = -1 + + write_output_state_to_file = .false. + single_file_out = .false. + output_state_files = 'perfect_output_d01.nc' + output_interval = 1 + + 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 + + async = 0 + adv_ens_command = "../shell_scripts/advance_model.csh" + + trace_execution = .true. + output_timestamps = .false. + print_every_nth_obs = -1 + output_forward_op_errors = .true. + silence = .false. + / + +# Example for f10.7 estimation. +# input_state_file_list = 'restart_p_files.txt', 'secondary_files.txt', 'f10.7.txt' +# output_state_file_list = 'out_restart_p_files.txt', 'out_secondary_files.txt', 'out_f10.7.txt' + +&filter_nml + single_file_in = .false., + input_state_files = '' + input_state_file_list = 'restart_p_files.txt', 'secondary_files.txt' + init_time_days = 153131, + init_time_seconds = 0, + perturb_from_single_instance = .true., + perturbation_amplitude = 0.2, + + stages_to_write = 'output' + + single_file_out = .false., + output_state_files = '' + output_state_file_list = 'out_restart_p_files.txt', 'out_secondary_files.txt' + output_interval = 1, + output_members = .true. + num_output_state_members = 0, + output_mean = .true. + output_sd = .true. + write_all_stages_at_end = .false. + compute_posterior = .true. + + ens_size = 20, + num_groups = 1, + distributed_state = .true. + + async = 4, + adv_ens_command = "./advance_model.csh", + tasks_per_model_advance = 1 + + obs_sequence_in_name = "obs_seq.out.1", + obs_sequence_out_name = "obs_seq.final", + num_output_obs_members = 20, + first_obs_days = -1, + first_obs_seconds = -1, + last_obs_days = -1, + last_obs_seconds = -1, + obs_window_days = -1, + obs_window_seconds = -1, + + inf_flavor = 0, 0, + inf_initial_from_restart = .false., .false., + inf_sd_initial_from_restart = .false., .false., + inf_deterministic = .true., .true., + inf_initial = 1.0, 1.0, + inf_lower_bound = 0.0, 1.0, + inf_upper_bound = 1000000.0, 1000000.0, + inf_damping = 1.0, 1.0, + inf_sd_initial = 0.0, 0.0, + inf_sd_lower_bound = 0.0, 0.0 + inf_sd_max_change = 1.05, 1.05, + + trace_execution = .false., + output_timestamps = .false., + output_forward_op_errors = .false., + write_obs_every_cycle = .false., + silence = .false., + + allow_missing_clm = .false. + / + + + +&ensemble_manager_nml + / + +&assim_tools_nml + filter_kind = 1 + cutoff = 0.2 + 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 = 0 + / + +# Each variable must have 6 entries. +# 1: variable name +# 2: DART KIND +# 3: minimum value - as a character string - if none, use 'NA' +# 4: maximum value - as a character string - if none, use 'NA' +# 5: which aether netcdf file contains the variable - restart or secondary +# 6: does the updated variable +# 'UPDATE' => updated variable written to file +# 'NO_COPY_BACK' => variable not written to file +# all these variables will be updated INTERNALLY IN DART. +# +# This is an example of how to restrict the range of each variable +# variables = 'NE', 'QTY_ELECTRON_DENSITY', '1000.0', 'NA', 'restart', 'UPDATE', +# 'TN', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'UPDATE', +# 'TN_NM', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'NO_COPY_BACK', +# 'O1', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.98888', 'restart', 'UPDATE', +# 'O1_NM', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.98888', 'restart', 'NO_COPY_BACK', +# 'O2', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.98888', 'restart', 'UPDATE', +# 'O2_NM', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.98888', 'restart', 'NO_COPY_BACK', +# 'UN', 'QTY_U_WIND_COMPONENT', 'NA', 'NA', 'restart', 'UPDATE', +# 'UN_NM', 'QTY_U_WIND_COMPONENT', 'NA', 'NA', 'restart', 'NO_COPY_BACK', +# 'VN', 'QTY_V_WIND_COMPONENT', 'NA', 'NA', 'restart', 'UPDATE', +# 'VN_NM', 'QTY_V_WIND_COMPONENT', 'NA', 'NA', 'restart', 'NO_COPY_BACK', +# 'OP', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', +# 'TI', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'restart', 'NO_COPY_BACK', +# 'TE', 'QTY_TEMPERATURE_ELECTRON', 'NA', 'NA', 'restart', 'NO_COPY_BACK', +# 'ZG', 'QTY_GEOMETRIC_HEIGHT', 'NA', 'NA', 'secondary', 'NO_COPY_BACK', +# 'f10_7' 'QTY_1D_PARAMETER' 'NA', 'NA', 'calculate', 'UPDATE' +# &model_nml +# debug = 1 +# tiegcm_restart_file_name = 'tiegcm_restart_p.nc' +# tiegcm_secondary_file_name = 'tiegcm_s.nc' +# estimate_f10_7 = .false. +# f10_7_file_name = 'f10_7.nc' +# assimilation_period_seconds = 3600 +# variables = 'NE', 'QTY_ELECTRON_DENSITY', '1000.0', 'NA', 'restart', 'UPDATE' +# 'OP', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', +# 'TI', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'restart', 'UPDATE', +# 'TE', 'QTY_TEMPERATURE_ELECTRON', 'NA', 'NA', 'restart', 'UPDATE', +# 'OP_NM', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', +# 'O1', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.99999', 'restart', 'NO_COPY_BACK', +# 'O2', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.99999', 'restart', 'UPDATE', +# 'TN', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'UPDATE', +# 'ZG', 'QTY_GEOMETRIC_HEIGHT', 'NA', 'NA', 'secondary', 'NO_COPY_BACK', +# / + +&model_nml + gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', + assimilation_period_days = 0, + assimilation_period_seconds = 1800, + model_perturbation_amplitude = 0.2, + calendar = 'Gregorian', + debug = 0, + gitm_state_variables = + 'Temperature', 'QTY_TEMPERATURE', + 'eTemperature', 'QTY_TEMPERATURE_ELECTRON', + 'ITemperature', 'QTY_TEMPERATURE_ION', + 'iO_3P_NDensityS', 'QTY_DENSITY_NEUTRAL_O3P', + 'iO2_NDensityS', 'QTY_DENSITY_NEUTRAL_O2', + 'iN2_NDensityS', 'QTY_DENSITY_NEUTRAL_N2', + 'iN_4S_NDensityS', 'QTY_DENSITY_NEUTRAL_N4S', + 'iNO_NDensityS', 'QTY_DENSITY_NEUTRAL_NO', + 'iN_2D_NDensityS', 'QTY_DENSITY_NEUTRAL_N2D', + 'iN_2P_NDensityS', 'QTY_DENSITY_NEUTRAL_N2P', + 'iH_NDensityS', 'QTY_DENSITY_NEUTRAL_H', + 'iHe_NDensityS', 'QTY_DENSITY_NEUTRAL_HE', + 'iCO2_NDensityS', 'QTY_DENSITY_NEUTRAL_CO2', + 'iO_1D_NDensityS', 'QTY_DENSITY_NEUTRAL_O1D', + 'iO_4SP_IDensityS', 'QTY_DENSITY_ION_O4SP', + 'iO2P_IDensityS', 'QTY_DENSITY_ION_O2P', + 'iN2P_IDensityS', 'QTY_DENSITY_ION_N2P', + 'iNP_IDensityS', 'QTY_DENSITY_ION_NP', + 'iNOP_IDensityS', 'QTY_DENSITY_ION_NOP', + 'iO_2DP_IDensityS', 'QTY_DENSITY_ION_O2DP', + 'iO_2PP_IDensityS', 'QTY_DENSITY_ION_O2PP', + 'iHP_IDensityS', 'QTY_DENSITY_ION_HP', + 'iHeP_IDensityS', 'QTY_DENSITY_ION_HEP', + 'ie_IDensityS', 'QTY_DENSITY_ION_E', + 'U_Velocity_component', 'QTY_VELOCITY_U', + 'V_Velocity_component', 'QTY_VELOCITY_V', + 'W_Velocity_component', 'QTY_VELOCITY_W', + 'U_IVelocity_component', 'QTY_VELOCITY_U_ION', + 'V_IVelocity_component', 'QTY_VELOCITY_V_ION', + 'W_IVelocity_component', 'QTY_VELOCITY_W_ION', + 'iO_3P_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_O3P', + 'iO2_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_O2', + 'iN2_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_N2', + 'iN_4S_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_N4S', + 'iNO_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_NO', + 'f107', 'QTY_1D_PARAMETER', + 'Rho', 'QTY_DENSITY', + / + +&aether_to_dart_nml + aether_restart_input_dirname = 'none' + aether_to_dart_output_file = 'filter_input.nc' + / + +&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. + / + +&obs_kind_nml + assimilate_these_obs_types = 'CHAMP_DENSITY', 'GPS_VTEC_EXTRAP', 'GPS_PROFILE', 'COSMIC_ELECTRON_DENSITY' + evaluate_these_obs_types = 'GND_GPS_VTEC' + / + +&location_nml + horiz_dist_only = .true. + vert_normalization_pressure = 100000.0 + vert_normalization_height = 10000.0 + vert_normalization_level = 20.0 + approximate_distance = .false. + nlon = 71 + nlat = 36 + output_box_info = .false. + / + +&preprocess_nml + overwrite_output = .true. + input_obs_qty_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90' + output_obs_qty_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' + obs_type_files = '../../../observations/forward_operators/obs_def_upper_atm_mod.f90', + '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90', + '../../../observations/forward_operators/obs_def_altimeter_mod.f90', + '../../../observations/forward_operators/obs_def_metar_mod.f90', + '../../../observations/forward_operators/obs_def_dew_point_mod.f90', + '../../../observations/forward_operators/obs_def_rel_humidity_mod.f90', + '../../../observations/forward_operators/obs_def_gps_mod.f90', + '../../../observations/forward_operators/obs_def_vortex_mod.f90', + '../../../observations/forward_operators/obs_def_gts_mod.f90' + quantity_files = '../../../assimilation_code/modules/observations/atmosphere_quantities_mod.f90', + '../../../assimilation_code/modules/observations/space_quantities_mod.f90', + '../../../assimilation_code//modules/observations/chemistry_quantities_mod.f90' + / + +&utilities_nml + TERMLEVEL = 1 + module_details = .true. + logfilename = 'dart_log.out' + nmlfilename = 'dart_log.nml' + write_nml = 'file' + / + +&mpi_utilities_nml + / + + + / + +# 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] + +&obs_diag_nml + obs_sequence_name = 'obs_seq.final' + obs_sequence_list = '' + first_bin_center = 2005, 9, 9, 0, 0, 0 + last_bin_center = 2005, 9, 10, 0, 0, 0 + bin_separation = 0, 0, 0, 1, 0, 0 + bin_width = 0, 0, 0, 1, 0, 0 + time_to_skip = 0, 0, 0, 1, 0, 0 + max_num_bins = 1000 + trusted_obs = 'null' + Nregions = 4 + hlevel = 0, 100000, 200000, 300000, 400000, 500000, 600000, 700000, 800000, 900000, 1000000 + 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 = .true. + / + +# obs_seq_to_netcdf also requires the schedule_nml. +# In this context, schedule_nml defines how many netcdf files get created. +# Each 'bin' results in an obs_epoch_xxxx.nc file. +# default is to put everything into one 'bin'. + +&obs_seq_to_netcdf_nml + obs_sequence_name = 'obs_seq.final' + obs_sequence_list = '' + append_to_netcdf = .false. + lonlim1 = 0.0 + lonlim2 = 360.0 + latlim1 = -90.0 + latlim2 = 90.0 + 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 + bin_interval_days = 1000000 + bin_interval_seconds = 0 + max_num_bins = 1000 + print_table = .true. + / + +&obs_sequence_tool_nml + num_input_files = 1 + filename_seq = 'obs_seq.out' + filename_out = 'obs_seq.processed' + first_obs_days = -1 + first_obs_seconds = -1 + last_obs_days = -1 + last_obs_seconds = -1 + obs_types = '' + keep_types = .false. + print_only = .false. + min_lat = -90.0 + max_lat = 90.0 + min_lon = 0.0 + max_lon = 360.0 + / + +&model_mod_check_nml + input_state_files = "tiegcm_restart_p.nc", "tiegcm_s.nc" + output_state_files = "mmc_output_p.nc", "mmc_output_s.nc" + test1thru = 7 + run_tests = 0,1,2,3,4,5,7 + x_ind = 1 + loc_of_interest = 240.0, 12.49, 200000.0 + quantity_of_interest = 'QTY_DENSITY_ION_OP' + interp_test_dlon = 5 + interp_test_dlat = 5 + interp_test_dvert = 50000.0 + interp_test_lonrange = 0, 360 + interp_test_latrange = -87.5, 87.5 + interp_test_vertrange = 200000.0, 300000.0 + interp_test_vertcoord = 'VERTISHEIGHT' + verbose = .false. + / + diff --git a/models/aether_lon-lat/work/out_restart_p_files.txt b/models/aether_lon-lat/work/out_restart_p_files.txt new file mode 100644 index 0000000000..02219d5699 --- /dev/null +++ b/models/aether_lon-lat/work/out_restart_p_files.txt @@ -0,0 +1,20 @@ +out_tiegcm_restart_p_01.nc +out_tiegcm_restart_p_02.nc +out_tiegcm_restart_p_03.nc +out_tiegcm_restart_p_04.nc +out_tiegcm_restart_p_05.nc +out_tiegcm_restart_p_06.nc +out_tiegcm_restart_p_07.nc +out_tiegcm_restart_p_08.nc +out_tiegcm_restart_p_09.nc +out_tiegcm_restart_p_10.nc +out_tiegcm_restart_p_11.nc +out_tiegcm_restart_p_12.nc +out_tiegcm_restart_p_13.nc +out_tiegcm_restart_p_14.nc +out_tiegcm_restart_p_15.nc +out_tiegcm_restart_p_16.nc +out_tiegcm_restart_p_17.nc +out_tiegcm_restart_p_18.nc +out_tiegcm_restart_p_19.nc +out_tiegcm_restart_p_20.nc diff --git a/models/aether_lon-lat/work/out_secondary_files.txt b/models/aether_lon-lat/work/out_secondary_files.txt new file mode 100644 index 0000000000..d2773e20e0 --- /dev/null +++ b/models/aether_lon-lat/work/out_secondary_files.txt @@ -0,0 +1,20 @@ +out_tiegcm_s_01.nc +out_tiegcm_s_02.nc +out_tiegcm_s_03.nc +out_tiegcm_s_04.nc +out_tiegcm_s_05.nc +out_tiegcm_s_06.nc +out_tiegcm_s_07.nc +out_tiegcm_s_08.nc +out_tiegcm_s_09.nc +out_tiegcm_s_10.nc +out_tiegcm_s_11.nc +out_tiegcm_s_12.nc +out_tiegcm_s_13.nc +out_tiegcm_s_14.nc +out_tiegcm_s_15.nc +out_tiegcm_s_16.nc +out_tiegcm_s_17.nc +out_tiegcm_s_18.nc +out_tiegcm_s_19.nc +out_tiegcm_s_20.nc diff --git a/models/aether_lon-lat/work/quickbuild.sh b/models/aether_lon-lat/work/quickbuild.sh new file mode 100755 index 0000000000..eece86e9c3 --- /dev/null +++ b/models/aether_lon-lat/work/quickbuild.sh @@ -0,0 +1,48 @@ +#!/usr/bin/env 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 + +main() { + +export DART=$(git rev-parse --show-toplevel) +source "$DART"/build_templates/buildfunctions.sh + +MODEL=aether_lon-lat +LOCATION=threed_sphere + +programs=( +) +# filter +# model_mod_check +# perfect_model_obs + +serial_programs=( +aether_to_dart +) +# create_fixed_network_seq +# create_obs_sequence +# obs_diag +# obs_seq_to_netcdf + +arguments "$@" + +# clean the directory +\rm -f -- *.o *.mod Makefile .cppdefs + +# build any NetCDF files from .cdl files +cdl_to_netcdf + +# build and run preprocess before making any other DART executables +buildpreprocess + +# build DART +buildit + +# clean up +\rm -f -- *.o *.mod + +} + +main "$@" diff --git a/models/aether_lon-lat/work/restart_p_files.txt b/models/aether_lon-lat/work/restart_p_files.txt new file mode 100644 index 0000000000..742bd03c80 --- /dev/null +++ b/models/aether_lon-lat/work/restart_p_files.txt @@ -0,0 +1 @@ +tiegcm_restart_p.nc diff --git a/models/aether_lon-lat/work/secondary_files.txt b/models/aether_lon-lat/work/secondary_files.txt new file mode 100644 index 0000000000..b430a9d435 --- /dev/null +++ b/models/aether_lon-lat/work/secondary_files.txt @@ -0,0 +1 @@ +tiegcm_s.nc From 19a5b0a17b2645da794faf4b09d11790276c1731 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sun, 22 Oct 2023 20:29:14 -0600 Subject: [PATCH 046/124] Standardized aether_to_dart dimensions and names The (gitm) code that reads the block(subdomain) files can continue to use the (x,y,z) dimensions. That will differentiate it from the code that creates the whole domain filter_input.nc, which will use more conventional dimensions (lon,lat,alt). Aether uses altitude instead of a pressure-type vertical coordinate, but parts of model_mod will need pressures at these altitudes. This commit focused on updating the dimensions used to define the filter_input.nc and some aspects of reading the block restart files. It does not: read in restart data (field names and source files are undecided). write whole domain data to a filter_input.nc read a filter_output.nc and divide it into block files make a running aether_to_dart program Modified: aether_to_dart.f90 Dimensions {lons,lats,alts} for whole domain, {x,y,z} for blocks. Initializes using static_init_blocks, not static_init_model. aether_to_dart.nml Updated from tiegcm to aether names. model_mod.f90 Commented out many subroutines that interfered with compiling just aether_to_mod. They may be needed later. Added restart file dimension variables to global storage. Translate time.json times into gregorian calendar. Calculates {nlon,nlat,nalt} from dimensions of block restart files. temporarily renamed in order to compile just aether_to_dart: dart_to_aether.f90 dart_aether_mod.f90 --- models/aether_lon-lat/aether_to_dart.f90 | 22 +- models/aether_lon-lat/aether_to_dart.nml | 2 +- ...r_mod.f90 => dart_aether_mod.f90.unneeded} | 0 ...o_aether.f90 => dart_to_aether.f90.notyet} | 0 models/aether_lon-lat/model_mod.f90 | 1762 ++++++++++------- 5 files changed, 1050 insertions(+), 736 deletions(-) rename models/aether_lon-lat/{dart_aether_mod.f90 => dart_aether_mod.f90.unneeded} (100%) rename models/aether_lon-lat/{dart_to_aether.f90 => dart_to_aether.f90.notyet} (100%) diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index 0edee1a640..697611bf2d 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -9,13 +9,13 @@ program aether_to_dart !---------------------------------------------------------------------- ! purpose: interface between the GITM model and DART ! -! method: Read aether "restart" files of model state (multiple files, one -! block per aether mpi task) +! method: Read aether "restart" files of model state (multiple files, +! one block per aether mpi task) ! Reform fields into a DART netcdf file ! -! USAGE: The aether dirname is read from the aether_in namelist -! -! aether_blocks_to_netcdf +! USAGE: The aether restart dirname and output filename are read from +! the aether_to_dart_nml namelist. +! !---------------------------------------------------------------------- use types_mod, only : r8 @@ -37,7 +37,7 @@ program aether_to_dart character(len=128), parameter :: revdate = "$Date$" character(len=512) :: string1, string2 -character(len=*), parameter :: program_name = 'aether_blocks_to_netcdf' +character(len=*), parameter :: program_name = 'aether_to_dart' !----------------------------------------------------------------------- ! namelist parameters with default values. @@ -46,8 +46,8 @@ program aether_to_dart character(len=256) :: aether_restart_input_dirname = 'none' character(len=256) :: aether_to_dart_output_file = 'filter_input.nc' -namelist /aether_to_dart/ aether_restart_input_dirname, & - aether_to_dart_output_file +namelist /aether_to_dart_nml/ aether_restart_input_dirname, & + aether_to_dart_output_file !---------------------------------------------------------------------- ! global storage @@ -63,9 +63,9 @@ program aether_to_dart ! Read the namelist !---------------------------------------------------------------------- -call find_namelist_in_file("input.nml", "aether_blocks_to_netcdf_nml", iunit) -read(iunit, nml = aether_blocks_to_netcdf_nml, iostat = io) -call check_namelist_read(iunit, io, "aether_blocks_to_netcdf_nml") ! closes, too. +call find_namelist_in_file("input.nml", "aether_to_dart_nml", iunit) +read(iunit, nml = aether_to_dart_nml, iostat = io) +call check_namelist_read(iunit, io, "aether_to_dart_nml") ! closes, too. !---------------------------------------------------------------------- ! Convert the files diff --git a/models/aether_lon-lat/aether_to_dart.nml b/models/aether_lon-lat/aether_to_dart.nml index 1bc2feee3b..c51c95888e 100644 --- a/models/aether_lon-lat/aether_to_dart.nml +++ b/models/aether_lon-lat/aether_to_dart.nml @@ -1,5 +1,5 @@ &aether_to_dart_nml - aether_restart_input_dirname = 'none' + aether_restart_input_dirname = 'testdata1/restartOut.Sphere.1member' aether_to_dart_output_file = 'filter_input.nc' / diff --git a/models/aether_lon-lat/dart_aether_mod.f90 b/models/aether_lon-lat/dart_aether_mod.f90.unneeded similarity index 100% rename from models/aether_lon-lat/dart_aether_mod.f90 rename to models/aether_lon-lat/dart_aether_mod.f90.unneeded diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90.notyet similarity index 100% rename from models/aether_lon-lat/dart_to_aether.f90 rename to models/aether_lon-lat/dart_to_aether.f90.notyet diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index d2baaa48ec..d627b5edbc 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -14,6 +14,7 @@ ! Parts of both may be useful and will be merged into a new aether_lon-lat nml. +! >>> See TODOs throughout, before compiling ! TODOs from models/tiegcm: ! - Nick Dietrich fix_mmr. When do to this? ! - model_time @@ -28,7 +29,7 @@ module model_mod ! !------------------------------------------------------------------------------- -use types_mod, only : r4, r8, i8, MISSING_R8, MISSING_R4, PI, & +use types_mod, only : r4, r8, i8, MISSING_R8, MISSING_R4, PI, RAD2DEG, & earth_radius, gravity, obstypelength, MISSING_I use time_manager_mod, only : time_type, set_calendar_type, set_time_missing, & @@ -47,7 +48,7 @@ module model_mod VERTISPRESSURE, VERTISHEIGHT, VERTISLEVEL, & vertical_localization_on, set_vertical -use utilities_mod, only : open_file, close_file, logfileunit, & +use utilities_mod, only : open_file, file_exist, close_file, logfileunit, & error_handler, E_ERR, E_MSG, E_WARN, nmlfileunit, & do_output, find_namelist_in_file, check_namelist_read, & do_nml_file, do_nml_term, register_module, & @@ -64,6 +65,12 @@ module model_mod QTY_VERTICAL_TEC, &! total electron content get_index_for_quantity +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 mpi_utilities_mod,only : my_task_id use default_model_mod, only : adv_1step, & @@ -84,16 +91,24 @@ module model_mod use ensemble_manager_mod, only : ensemble_type -use netcdf_utilities_mod, only : nc_synchronize_file, nc_add_global_attribute, & - nc_add_global_creation_time, nc_begin_define_mode, & - nc_define_dimension, nc_end_define_mode, & - nc_put_variable,nc_add_attribute_to_variable, & - nc_define_real_variable, & +use netcdf_utilities_mod, only : nc_synchronize_file, nc_add_global_attribute, & + nc_add_global_creation_time, nc_begin_define_mode, & + nc_define_dimension, nc_end_define_mode, & + nc_put_variable,nc_add_attribute_to_variable, & + nc_define_real_variable, & nc_check, nc_open_file_readonly, nc_get_dimension_size, & - nc_close_file, nc_get_variable + nc_close_file, nc_get_variable, & + nc_get_dimension_size, nc_create_file, & + nc_define_double_variable, nc_define_double_scalar + use dart_time_io_mod, only : write_model_time +! use dart_aether_mod, only : get_nxPerBlock, get_nyPerBlock, get_nzPerBlock +! TODO: How does aether provide the species?, & +! decode_gitm_indices +! get_nSpecies, get_nSpeciesTotal, get_nIons, get_nSpeciesAll, & + use netcdf implicit none @@ -119,10 +134,14 @@ module model_mod public :: adv_1step, & init_conditions, & init_time, & - pert_model_copies + pert_model_copies, & + get_state_time + +! Interfaces needed by aether_to_dart and dart_to_aether +public :: restart_files_to_netcdf ! version controlled file description for error handling, do not edit -character(len=256), parameter :: source = 'tiegcm/model_mod.f90' +character(len=256), parameter :: source = 'aether_lon-lat/model_mod.f90' character(len=32 ), parameter :: revision = '' character(len=128), parameter :: revdate = '' @@ -130,45 +149,60 @@ module model_mod ! namelist with default values -character(len=256) :: tiegcm_restart_file_name = 'tiegcm_restart_p.nc' -character(len=256) :: tiegcm_secondary_file_name = 'tiegcm_s.nc' +character(len=256) :: aether_restart_file_name = 'aether_restart_p.nc' +character(len=256) :: aether_secondary_file_name = 'tiegcm_s.nc' +! TODO; replace this GITM namelist var with Aether code. +character(len=256) :: template_filename = 'no_file_specified.nc' integer :: debug = 0 logical :: estimate_f10_7 = .false. character(len=256) :: f10_7_file_name = 'f10_7.nc' integer :: assimilation_period_seconds = 3600 real(r8) :: model_res = 5.0_r8 -integer, parameter :: MAX_NUM_VARIABLES = 30 +! TODO: confirm that the units are days. +! Better to get the actual start day of Aether's calender. +integer :: aeth_ref_day = 2451545.0 ! cJULIAN2000 in Aether = day of date 2000/01/01. +! Day 0 in this calendar is (+/1 a day) -4710/11/24 0 UTC +! But what we care about is the ref time for the times in the files, which is 1964-12-31 23:30 +! (from echo 2011032000 -1458347400s | ./advance_time). + +! TODO: It seems that this was intended to be 1965-01-01-0, but mayber there's a time step issue. +! This should be in a namelist. +integer, dimension(:) :: aeth_ref_date(5) = (/1964,12,31,23,30/) ! y,mo,d,h,m (secs assumed 0) + +! Aether restart files have 81 fields in them, +! mostly the 6 components of velocities for each ion. +integer, parameter :: MAX_NUM_VARIABLES = 100 integer, parameter :: MAX_NUM_COLUMNS = 6 character(len=NF90_MAX_NAME) :: variables(MAX_NUM_VARIABLES * MAX_NUM_COLUMNS) = ' ' -namelist /model_nml/ tiegcm_restart_file_name, & - tiegcm_secondary_file_name, & +namelist /model_nml/ aether_restart_file_name, & + aether_secondary_file_name, & variables, debug, estimate_f10_7, & f10_7_file_name, & assimilation_period_seconds, model_res - !------------------------------------------------------------------------------- -! define model parameters +! define model parameters for creating the state NetCDF file +! and handling interpolation, get_close, ... ! nilev is number of interface levels -! nlev is number of midpoint levels ->>> -! TODO: Change names to Aether names, not TIEGCM names ->>> -integer :: nilev, nlev, nlon, nlat -! TODO: levs -> alts? -real(r8),dimension(:), allocatable :: lons, lats, levs, ilevs, plevs, pilevs -! levels + top level boundary condition for nlev. -integer :: all_nlev -real(r8),dimension(:), allocatable :: all_levs -! HK are plevs, pilves per ensemble member? +! nalt is number of midpoint levels +! TODO: Are Xilev useful in Aether? +! Replace plevs with hlevs? Maybe not; pressure levels may be needed for interp. +integer :: nilev, nalt, nlon, nlat +real(r8),dimension(:), allocatable :: lons, lats, alts, ilevs, plevs, pilevs +! levels + top level boundary condition for nalt. +integer :: all_nalt +real(r8),dimension(:), allocatable :: all_alts +! HK are plevs, pilevs per ensemble member? real(r8) :: TIEGCM_reference_pressure integer :: time_step_seconds integer :: time_step_days type(time_type) :: time_step +type(quad_interp_handle) :: quad_interp + ! Codes for interpreting the columns of the variable_table integer, parameter :: VT_VARNAMEINDX = 1 ! variable name integer, parameter :: VT_KINDINDX = 2 ! DART quantity @@ -209,12 +243,43 @@ module model_mod logical, save :: module_initialized = .false. !=============================================================================== +! Define Aether whole-grid and block grid dimension variables. + +character(len=*), parameter :: LON_DIM_NAME = 'lon' +character(len=*), parameter :: LAT_DIM_NAME = 'lat' +character(len=*), parameter :: ALT_DIM_NAME = 'alt' + +character(len=*), parameter :: LON_VAR_NAME = 'lon' +character(len=*), parameter :: LAT_VAR_NAME = 'lat' +character(len=*), parameter :: ALT_VAR_NAME = 'alt' + +integer, parameter :: MAX_NAME_LEN = 256 +! {nxPerBlock,nyPerBlock} are the number of non-halo {lons,lats} PER block +! the number of blocks comes from UAM.in +! nzPerBlock is the number of altitudes, which does not depend on block +! nGhost is the halo region width in the block(subdomain) files. + +integer :: nxPerBlock, nyPerBlock, nzPerBlock +integer, parameter :: nGhost = 2 ! number of ghost cells on all edges + +! "... keep in mind that if the model resolution is 5 deg latitude, +! the model will actually go from -87.5 to 87.5 latitude +! (even though you specify -90 to 90 in the UAM.in file), +! since the latitudes/longitudes are at cell centers, +! while the edges are at the boundaries." -- Aaron Ridley + +integer :: nBlocksLon=-1, nBlocksLat=-1 ! number of blocks along each dim +real(r8) :: LatStart=MISSING_R8, LatEnd=MISSING_R8, LonStart=MISSING_R8 +! TODO; Changing defaults from -1 just so it will compile. +integer :: nSpeciesTotal=1, nSpecies=1, nIons=1, nSpeciesAll=1 + contains !=============================================================================== subroutine static_init_model() integer :: iunit, io +character(len=*), parameter :: routine = 'static_init_model' if (module_initialized) return ! only need to do this once @@ -230,36 +295,36 @@ subroutine static_init_model() write( * ,*)'static_init_model: debug level is ',debug write(logfileunit,*)'static_init_model: debug level is ',debug endif + !--------------------------------------------------------------- -! get grid dimensions and values +! get whole grid dimensions and values write(string1,'(3A)') "Now reading template file ",trim(template_filename),& " for grid information" call error_handler(E_MSG,routine,string1,source,revision,revdate) -call get_grid_info_from_netcdf(template_filename, NgridLon, NgridLat, NgridAlt) - -! TODO: replacing these with lons, lats, alts -allocate(LON(NgridLon)) -allocate(LAT(NgridLat)) -allocate(ALT(NgridAlt)) +allocate(lons(nlon)) +allocate(lats(nlat)) +allocate(alts(nalt)) !--------------------------------------------------------------- ! get grid dimensions and values -call get_grid_from_netcdf(template_filename, LON, LAT, ALT) +! TODO: reactivate after aether_to_dart tests +! lons, lats, alts and n??? are in global storage; remove from subr calls. +! call get_grid_from_netcdf(template_filename, lons, lats, alts) !--------------------------------------------------------------- ! mass points at cell centers -call init_quad_interp(GRID_QUAD_IRREG_SPACED_REGULAR, nGridLon, nGridLat, & +call init_quad_interp(GRID_QUAD_IRREG_SPACED_REGULAR, nlon, nlat, & QUAD_LOCATED_CELL_CENTERS, & global=.false., spans_lon_zero=.false., pole_wrap=.false., & interp_handle=quad_interp) -call set_quad_coords(quad_interp, LON, LAT) +call set_quad_coords(quad_interp, lons, lats) if ( debug > 0 ) then - write(string1,'("grid: NgridLon, NgridLat, NgridAlt =",3(1x,i5))') NgridLon, NgridLat, NgridAlt + write(string1,'("grid: nlon, nlat, nalt =",3(1x,i5))') nlon, nlat, nalt call error_handler(E_MSG,routine,string1,source,revision,revdate) endif @@ -274,7 +339,7 @@ subroutine static_init_model() call set_calendar_type('Gregorian') ! Convert the last year/day/hour/minute to a dart time. -state_time = read_model_time(tiegcm_restart_file_name) +state_time = read_model_time(aether_restart_file_name) ! Assumes assimilation_period is a multiple of the dynamical timestep ! TIEGCM namelist has variable "STOP" @@ -287,12 +352,12 @@ end subroutine static_init_model ! Read the lon, lat, and alt arrays from the ncid -subroutine get_grid_from_netcdf(template_filename, LON, LAT, ALT ) +subroutine get_grid_from_netcdf(template_filename, lons, lats, alts ) character(len=*), intent(in) :: template_filename -real(r8), intent(inout) :: LON(:) -real(r8), intent(inout) :: LAT(:) -real(r8), intent(inout) :: ALT(:) +real(r8), intent(inout) :: lons(:) +real(r8), intent(inout) :: lats(:) +real(r8), intent(inout) :: alts(:) character(len=*), parameter :: routine = 'get_grid_from_netcdf' @@ -300,9 +365,9 @@ subroutine get_grid_from_netcdf(template_filename, LON, LAT, ALT ) ncid = nc_open_file_readonly(template_filename, routine) -call nc_get_variable(ncid, LAT_VAR_NAME, LAT, routine) -call nc_get_variable(ncid, LON_VAR_NAME, LON, routine) -call nc_get_variable(ncid, ALT_VAR_NAME, ALT, routine) +call nc_get_variable(ncid, LON_VAR_NAME, lons, routine) +call nc_get_variable(ncid, LAT_VAR_NAME, lats, routine) +call nc_get_variable(ncid, ALT_VAR_NAME, alts, routine) call nc_close_file(ncid) @@ -320,90 +385,100 @@ subroutine static_init_blocks(restart_dirname) integer :: iunit, io, ivar !logical :: has_gitm_namelist +! Read the namelist entry for model_mod from input.nml call read_model_namelist() +! error-check, convert namelist input to variable_table, and build the state structure +call verify_variables() + + ! 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) -! Read the DART namelist for this model -call find_namelist_in_file('input.nml', 'gitm_blocks_nml', iunit) -read(iunit, nml = gitm_blocks_nml, iostat = io) -call check_namelist_read(iunit, io, 'gitm_blocks_nml') - -! Record the namelist values used for the run -if (do_nml_file()) write(nmlfileunit, nml=gitm_blocks_nml) -if (do_nml_term()) write( * , nml=gitm_blocks_nml) +! TODO: this is done only in aether_to_dart? +! ! Read the DART namelist for this model +! call find_namelist_in_file('input.nml', 'aether_to_dart_nml', iunit) +! read(iunit, nml = aether_to_dart_nml, iostat = io) +! call check_namelist_read(iunit, io, 'aether_to_dart_nml') +! +! ! Record the namelist values used for the run +! if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) +! if (do_nml_term()) write( * , nml=aether_to_dart_nml) ! Get the GITM variables in a restricted scope setting. -nSpecies = get_nSpecies() -nSpeciesTotal = get_nSpeciesTotal() -nIons = get_nIons() -nSpeciesAll = get_nSpeciesAll() -nLonsPerBlock = get_nLonsPerBlock() -nLatsPerBlock = get_nLatsPerBlock() -nAltsPerBlock = get_nAltsPerBlock() +! TODO: Replace with Aether code +! nSpecies = get_nSpecies() +! nSpeciesTotal = get_nSpeciesTotal() +! nIons = get_nIons() +! nSpeciesAll = get_nSpeciesAll() +! TODO: These are calculated in get_grid_from_blocks +! nxPerBlock = get_nxPerBlock() +! nyPerBlock = get_nyPerBlock() +! nzPerBlock = get_nzPerBlock() !--------------------------------------------------------------- ! Set the time step ... causes gitm namelists to be read. ! Ensures model_advance_time is multiple of 'dynamics_timestep' -call set_calendar_type( calendar ) ! comes from model_mod_nml +call set_calendar_type( 'Gregorian' ) ! comes from model_mod_nml !--------------------------------------------------------------- ! 1) get grid dimensions ! 2) allocate space for the grids ! 3) read them from the block restart files, could be stretched ... -call get_grid_info_from_blocks(restart_dirname, NgridLon, NgridLat, NgridAlt, nBlocksLon, & +call get_grid_info_from_blocks(restart_dirname, nlon, nlat, nalt, nBlocksLon, & nBlocksLat, LatStart, LatEnd, LonStart) if( debug > 0 ) then - write(string1,*) 'grid dims are ',NgridLon,NgridLat,NgridAlt + write(string1,*) 'grid dims are ',nlon,nlat,nalt call error_handler(E_MSG,routine,string1,source,revision,revdate) endif -! TODO; this is also done in gitm's static_init_model, which is not called by aether_to_dart, -! so it's not redundant. -allocate( LON( NgridLon )) -allocate( LAT( NgridLat )) -allocate( ALT( NgridAlt )) +! This is also done in gitm's static_init_model, which is not called by aether_to_dart, +! so it's not redundant. +allocate( lons( nlon )) +allocate( lats( nlat )) +allocate( alts( nalt )) +! TODO; This defines n[xyz]PerBlock call get_grid_from_blocks(restart_dirname, nBlocksLon, nBlocksLat, & - nLonsPerBlock, nLatsPerBlock, nAltsPerBlock, LON, LAT, ALT ) + nxPerBlock, nyPerBlock, nzPerBlock, lons, lats, alts ) ! this is going to have to loop over all the blocks, both to get ! the data values and to get the full grid spacings. -model_time = get_state_time(restart_dirname) +state_time = get_state_time(restart_dirname) if (do_output()) & - call print_time(model_time,'time in restart file '//trim(restart_dirname)//'/header.rst') + call print_time(state_time,'time in restart file '//trim(restart_dirname)//'/time.json') if (do_output()) & - call print_date(model_time,'date in restart file '//trim(restart_dirname)//'/header.rst') - -call verify_block_variables( gitm_block_variables, nfields ) - -do ivar = 1, nfields + call print_date(state_time,'date in restart file '//trim(restart_dirname)//'/time.json') - varname = trim(gitm_block_variables(ivar)) - gitmvar(ivar)%varname = varname - - ! This routine also checks to make sure user specified accurate GITM variables - call decode_gitm_indices( varname, & - gitmvar(ivar)%gitm_varname, & - gitmvar(ivar)%gitm_dim, & - gitmvar(ivar)%gitm_index, & - gitmvar(ivar)%long_name, & - gitmvar(ivar)%units) - if ( debug > 0 ) then - call print_gitmvar_info(ivar,routine) - endif -enddo +! TODO: Replace with aether variables check? +! call verify_block_variables( gitm_block_variables, nfields ) +! +! do ivar = 1, nfields +! +! varname = trim(gitm_block_variables(ivar)) +! gitmvar(ivar)%varname = varname +! +! ! This routine also checks to make sure user specified accurate GITM variables +! call decode_gitm_indices( varname, & +! gitmvar(ivar)%gitm_varname, & +! gitmvar(ivar)%gitm_dim, & +! gitmvar(ivar)%gitm_index, & +! gitmvar(ivar)%long_name, & +! gitmvar(ivar)%units) +! if ( debug > 0 ) then +! call print_gitmvar_info(ivar,routine) +! endif +! enddo if ( debug > 0 ) then - write(string1,'("grid: NgridLon, NgridLat, NgridAlt =",3(1x,i5))') NgridLon, NgridLat, NgridAlt + write(string1,'("grid: nlon, nlat, nalt =",3(1x,i5))') nlon, nlat, nalt call error_handler(E_MSG,routine,string1,source,revision,revdate) endif @@ -428,21 +503,24 @@ end subroutine read_model_namelist !================================================================== -!> Read the grid dimensions from the restart netcdf file. -!> KDR: I don't see a netcdf file. UAM.in is text and doesn't have any .nc file names in it. +!> Read the grid dimensions from a restart netcdf file. !> !> The file name comes from module storage ... namelist. -subroutine get_grid_info_from_blocks(gitm_restart_dirname, NgridLon, NgridLat, & - NgridAlt, nBlocksLon, nBlocksLat, LatStart, LatEnd, LonStart) +subroutine get_grid_info_from_blocks(gitm_restart_dirname, nlon, nlat, & + nalt, nBlocksLon, nBlocksLat, LatStart, LatEnd, LonStart) character(len=*), intent(in) :: gitm_restart_dirname -integer, intent(out) :: NgridLon ! Number of Longitude centers -integer, intent(out) :: NgridLat ! Number of Latitude centers -integer, intent(out) :: NgridAlt ! Number of Vertical grid centers +integer, intent(out) :: nlon ! Number of Longitude centers +integer, intent(out) :: nlat ! Number of Latitude centers +integer, intent(out) :: nalt ! Number of Vertical grid centers integer, intent(out) :: nBlocksLon, nBlocksLat real(r8), intent(out) :: LatStart, LatEnd, LonStart +! TODO: get the grid info from a namelists (98 variables), instead of GITM's UAM.in. +! Then remove functions read_in_*. +! The rest of the UAM.in contents are for running GITM. +! Can wait until aether_to_dart push is done. character(len=*), parameter :: filename = 'UAM.in' character(len=100) :: cLine ! iCharLen_ == 100 @@ -496,10 +574,6 @@ subroutine get_grid_info_from_blocks(gitm_restart_dirname, NgridLon, NgridLat, & if (debug > 4) then write(string1,*) 'Successfully read GITM restart file:',trim(fileloc) call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nLonsPerBlock:',nLonsPerBlock - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nLatsPerBlock:',nLatsPerBlock - call error_handler(E_MSG,routine,string1,source,revision,revdate) write(string1,*) ' nBlocksLon:',nBlocksLon call error_handler(E_MSG,routine,string1,source,revision,revdate) write(string1,*) ' nBlocksLat:',nBlocksLat @@ -514,128 +588,339 @@ subroutine get_grid_info_from_blocks(gitm_restart_dirname, NgridLon, NgridLat, & call close_file(iunit) -NgridLon = nBlocksLon * nLonsPerBlock -NgridLat = nBlocksLat * nLatsPerBlock -NgridAlt = nAltsPerBlock +nlon = nBlocksLon * nxPerBlock +nlat = nBlocksLat * nyPerBlock +nalt = nzPerBlock -write(string1,*) 'NgridLon = ', NgridLon +write(string1,*) 'nlon = ', nlon call error_handler(E_MSG,routine,string1,source,revision,revdate) -write(string1,*) 'NgridLat = ', NgridLat +write(string1,*) 'nlat = ', nlat call error_handler(E_MSG,routine,string1,source,revision,revdate) -write(string1,*) 'NgridAlt = ', NgridAlt +write(string1,*) 'nalt = ', nalt call error_handler(E_MSG,routine,string1,source,revision,revdate) end subroutine get_grid_info_from_blocks !================================================================== +function read_in_int(iunit,varname,filename) + +integer, intent(in) :: iunit +character(len=*), intent(in) :: varname,filename +integer :: read_in_int + +character(len=100) :: cLine +integer :: i, ios + +! Read a line +read(iunit,'(a)',iostat=ios) cLine +if (ios /= 0) then + write(string1,*) 'cannot find '//trim(varname)//' in '//trim(filename) + call error_handler(E_ERR,'get_grid_dims',string1,source,revision,revdate) +endif + +! Remove anything after a space or TAB +i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' +i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' + +read(cLine,*,iostat=ios)read_in_int + +if(ios /= 0) then + write(string1,*)'unable to read '//trim(varname)//' in '//trim(filename) + call error_handler(E_ERR,'read_in_int',string1,source,revision,revdate,& + text2=cLine) +endif + +end function read_in_int + +!================================================================= + +function read_in_real(iunit,varname,filename) + +integer, intent(in) :: iunit +character(len=*), intent(in) :: varname,filename +real(r8) :: read_in_real + +character(len=100) :: cLine +integer :: i, ios + +! Read a line +read(iunit,'(a)',iostat=ios) cLine +if (ios /= 0) then + write(string1,*) 'cannot find '//trim(varname)//' in '//trim(filename) + call error_handler(E_ERR,'get_grid_dims',string1,source,revision,revdate) +endif + +! Remove anything after a space or TAB +i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' +i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' + +! Now that we have a line with nothing else ... parse it +read(cLine,*,iostat=ios)read_in_real + +if(ios /= 0) then + write(string1,*)'unable to read '//trim(varname)//' in '//trim(filename) + call error_handler(E_ERR,'read_in_real',string1,source,revision,revdate) +endif + +end function read_in_real + +!================================================================= + ! open enough of the restart files to read in the lon, lat, alt arrays subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, & - nLonsPerBlock, nLatsPerBlock, nAltsPerBlock, & - LON, LAT, ALT ) + nxPerBlock, nyPerBlock, nzPerBlock, & + lons, lats, alts ) character(len=*), intent(in) :: dirname -integer, intent(in) :: nBlocksLon ! Number of Longitude blocks -integer, intent(in) :: nBlocksLat ! Number of Latitude blocks -integer, intent(in) :: nLonsPerBlock ! Number of Longitude centers per block -integer, intent(in) :: nLatsPerBlock ! Number of Latitude centers per block -integer, intent(in) :: nAltsPerBlock ! Number of Vertical grid centers +integer, intent(in) :: nBlocksLon ! Number of Longitude blocks +integer, intent(in) :: nBlocksLat ! Number of Latitude blocks +integer, intent(out) :: nxPerBlock ! Number of non-halo Longitude centers per block +integer, intent(out) :: nyPerBlock ! Number of non-halo Latitude centers per block +integer, intent(out) :: nzPerBlock ! Number of Vertical grid centers -real(r8), dimension( : ), intent(inout) :: LON, LAT, ALT +real(r8), dimension( : ), intent(inout) :: lons, lats, alts -integer :: ios, nb, offset, iunit, nboff +integer :: ios, nb, offset, ncid, nboff character(len=256) :: filename -real(r8), allocatable :: temp(:) +real(r8), allocatable :: temp(:,:,:) character(len=*), parameter :: routine = 'get_grid_from_blocks' +! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), +! in order to calculate the n[xyz]PerBlock dimensions. +! grid_g0000.nc looks like a worthy candidate, but a restart could be used. +! (GITM got these numbers from a model module) +write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' +ncid = nc_open_file_readonly(filename, routine) + +! The grid (and restart) file variables have halos, so strip them off +! to get the number of actual data values in each dimension of the block. +nxPerBlock = nc_get_dimension_size(ncid, 'x', routine) - 2*nGhost +nyPerBlock = nc_get_dimension_size(ncid, 'y', routine) - 2*nGhost +nzPerBlock = nc_get_dimension_size(ncid, 'z', routine) - 2*nGhost + +if (debug > 4) then + write(string1,*) 'Successfully read GITM grid file:',trim(filename) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nxPerBlock:',nxPerBlock + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nyPerBlock:',nyPerBlock + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nzPerBlock:',nzPerBlock + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif + ! a temp array large enough to hold any of the ! Lon,Lat or Alt array from a block plus ghost cells -allocate(temp(1-nGhost:max(nLonsPerBlock,nLatsPerBlock,nAltsPerBlock)+nGhost)) +allocate(temp(1-nGhost:nxPerBlock+nGhost, & + 1-nGhost:nyPerBlock+nGhost, & + 1:nzPerBlock)) ! go across the south-most block row picking up all longitudes do nb = 1, nBlocksLon - iunit = open_block_file(dirname, nb, 'read', filename) - - read(iunit,iostat=ios) temp(1-nGhost:nLonsPerBlock+nGhost) - if ( ios /= 0 ) then - print *,'size:',size(temp(1-nGhost:nLonsPerBlock+nGhost)) - print *,'IO error code:',ios - write(string1,*)'ERROR reading file ', trim(filename) - write(string2,*)'longitude block ',nb,' of ',nBlocksLon - call error_handler(E_ERR,'get_grid',string1, & - source,revision,revdate,text2=string2) - endif - - offset = (nLonsPerBlock * (nb - 1)) - LON(offset+1:offset+nLonsPerBlock) = temp(1:nLonsPerBlock) - - call close_file(iunit) +! TODO function open_block_file(dirname, filetype, memnum, blocknum, rw, filename) + ncid = open_block_file(dirname, 'grid', -1, nb-1, 'read', filename) + +! Read 3D array and extract the longitudes of the non-halo data of this block. + call nc_get_variable(ncid, 'Longitudes', temp, routine) +! TODO: nc_get_variable stops on error conditions, does not pass back ios. +! if ( ios /= 0 ) then +! print *,'size:',size(temp(1-nGhost:nxPerBlock+nGhost)) +! print *,'IO error code:',ios +! write(string1,*)'ERROR reading file ', trim(filename) +! write(string2,*)'longitude block ',nb,' of ',nBlocksLon +! call error_handler(E_ERR,'get_grid',string1, & +! source,revision,revdate,text2=string2) +! endif + + offset = (nxPerBlock * (nb - 1)) + lons(offset+1:offset+nxPerBlock) = temp(1:nxPerBlock,1,1) + + call nc_close_file(ncid) enddo ! go up west-most block row picking up all latitudes do nb = 1, nBlocksLat - nboff = ((nb - 1) * nBlocksLon) + 1 - iunit = open_block_file(dirname, nboff, 'read', filename) + ! TODO; Aether names start with 0, but the lat values can come from any lon=const column. + ! orig: nboff = ((nb - 1) * nBlocksLon) + 1 + nboff = ((nb - 1) * nBlocksLon) + ncid = open_block_file(dirname, 'grid', -1, nboff, 'read', filename) - ! get past lon array and read in lats - read(iunit) temp(1-nGhost:nLonsPerBlock+nGhost) + call nc_get_variable(ncid, 'Latitudes', temp, routine) +! if ( ios /= 0 ) then +! write(string1,*)'ERROR reading file ', trim(filename) +! write(string2,*)'latitude block ',nb,' of ',nBlocksLat +! call error_handler(E_ERR,'get_grid',string1, & +! source,revision,revdate,text2=string2) +! endif - read(iunit,iostat=ios) temp(1-nGhost:nLatsPerBlock+nGhost) - if ( ios /= 0 ) then - write(string1,*)'ERROR reading file ', trim(filename) - write(string2,*)'latitude block ',nb,' of ',nBlocksLat - call error_handler(E_ERR,'get_grid',string1, & - source,revision,revdate,text2=string2) - endif - - offset = (nLatsPerBlock * (nb - 1)) - LAT(offset+1:offset+nLatsPerBlock) = temp(1:nLatsPerBlock) + offset = (nyPerBlock * (nb - 1)) + lats(offset+1:offset+nyPerBlock) = temp(1,1:nyPerBlock,1) - call close_file(iunit) + call nc_close_file(ncid) enddo + ! this code assumes UseTopography is false - that all columns share ! the same altitude array, so we can read it from the first block. ! if this is not the case, this code has to change. -iunit = open_block_file(dirname, 1, 'read', filename) +ncid = open_block_file(dirname, 'grid', -1, 0, 'read', filename) -! get past lon and lat arrays and read in alt array -read(iunit) temp(1-nGhost:nLonsPerBlock+nGhost) -read(iunit) temp(1-nGhost:nLatsPerBlock+nGhost) -read(iunit) temp(1-nGhost:nAltsPerBlock+nGhost) +call nc_get_variable(ncid, 'Altitudes', temp, routine) -ALT(1:nAltsPerBlock) = temp(1:nAltsPerBlock) +alts(1:nzPerBlock) = temp(1,1,1:nzPerBlock) -call close_file(iunit) +call nc_close_file(ncid) deallocate(temp) ! convert from radians into degrees -LON = LON * rad2deg -LAT = LAT * rad2deg +lons = lons * RAD2DEG +lats = lats * RAD2DEG if (debug > 4) then - print *, 'All LONs ', LON - print *, 'All LATs ', LAT - print *, 'All ALTs ', ALT + print *, 'All lons ', lons + print *, 'All lats ', lats + print *, 'All alts ', alts endif -if ( debug > 1 ) then ! A little sanity check - write(string1,*)'LON range ',minval(LON),maxval(LON) +if ( debug > 1 ) then ! Check dimension limits + write(string1,*)'LON range ',minval(lons),maxval(lons) call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'LAT range ',minval(LAT),maxval(LAT) + write(string1,*)'LAT range ',minval(lats),maxval(lats) call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'ALT range ',minval(ALT),maxval(ALT) + write(string1,*)'ALT range ',minval(alts),maxval(alts) call error_handler(E_MSG,routine,string1,source,revision,revdate) endif end subroutine get_grid_from_blocks +!================================================================== +! the static_init_model ensures that the gitm namelists are read. +! + +function get_state_time( dirname ) +type(time_type) :: get_state_time +character(len=*), intent(in) :: dirname + +type(time_type) :: model_offset, base_time + +integer :: iunit, i, ios +integer :: istep +real(r8) :: tsimulation +integer :: ndays,nsecs, base_ndays, base_nsecs + +character(len=256) :: filename +character(len=100) :: cLine + +character(len=*), parameter :: routine = 'get_state_time' + +tsimulation = MISSING_R8 + +! TODO: should the source of the time be in a namelist? +! Tricky; time.json is a text file, restarts are NetCDF +write(filename,'(a,''/time.json'')') trim(dirname) + +iunit = open_file(trim(filename), action='read') + +FILEREAD : do i = 1, 10 + + read(iunit,'(a)',iostat=ios) cLine + + if (ios < 0) then + exit FILEREAD ! end of file + + else if (ios > 0) then + write(string1,*) 'cannot read ',trim(filename) + call error_handler(E_ERR,routine,string1,source,revision,revdate) + + else + select case( cLine(4:8) ) + case('istep') + read(iunit,*)istep + case('curre') + read(iunit,*)tsimulation + case default + end select + endif + +enddo FILEREAD + +call close_file(iunit) + +base_time = set_date(aeth_ref_date(1), aeth_ref_date(2), aeth_ref_date(3), & + aeth_ref_date(4), aeth_ref_date(5)) +call get_time(base_time,base_nsecs,base_ndays) +ndays = tsimulation/86400 +nsecs = tsimulation - ndays*86400 +ndays = base_ndays + ndays +get_state_time = set_time(nsecs,ndays) + +if (debug > 8) then + write(string1,*)'tsimulation ',tsimulation + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*)'ndays ',ndays + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*)'nsecs ',nsecs + call error_handler(E_MSG,routine,string1,source,revision,revdate) + + call print_date( base_time, 'get_state_time:model base date') + call print_time( base_time, 'get_state_time:model base time') + call print_date(get_state_time, 'get_state_time:model date') + call print_time(get_state_time, 'get_state_time:model time') +endif + +end function get_state_time + + +!================================================================== +!================================================================== + +!> open the requested block number restart file and return the ncid + +function open_block_file(dirname, filetype, memnum, blocknum, rw, filename) + +integer :: open_block_file +character(len=*), intent(in) :: dirname +character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} +! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? +! This code can handle it; a longer filetype passed in, and no member +integer, intent(in) :: blocknum +integer, intent(in) :: memnum +character(len=*), intent(in) :: rw ! 'read' or 'readwrite' +character(len=*), intent(out) :: filename +character(len=*), parameter :: routine = 'open_block_file' + +filename = trim(dirname)//'/'//trim(filetype) +if (memnum > 0) write(filename, '(A,A2,I4)') filename, '_m', memnum +if (blocknum > 0) write(filename, '(A,A2,I4)') filename, '_b', blocknum +filename = filename//'.nc' + +if ( rw == 'read' .and. .not. file_exist(filename) ) then + write(string1,*) 'cannot open file ', trim(filename),' for reading.' + call error_handler(E_ERR,'open_block_file',string1,source,revision,revdate) +endif + +if (debug > 0) then + write(string1,*) 'Opening file ', trim(filename), ' for ', trim(rw) + call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) +end if + +open_block_file = nc_open_file_readonly(filename, routine) + +if (debug > 80) then + write(string1,*) 'Returned file descriptor is ', open_block_file + call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) +end if + +end function open_block_file + + !================================================================= subroutine verify_block_variables( variable_array, ngood) @@ -669,7 +954,8 @@ subroutine verify_block_variables( variable_array, ngood) end subroutine verify_block_variables !================================================================== -!> Converts gitm restart files to a netCDF file +!> Converts Aether restart files to a netCDF file +!> Modified from models/gitm/model_mod.f90 !> !> This routine needs: !> @@ -685,13 +971,13 @@ end subroutine verify_block_variables !> !> In the process, the routine will find: !> -!> 1. The overall grid size, lon/lat/alt when you've read in all -!> the blocks. (nGridLon, nGridLat, nGridAlt) +!> 1. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. +!> (nBlocksLon, nBlocksLat, 1) !> !> 2. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) !> -!> 3. The number of lon/lats in a single grid block (nLonsPerBlock, -!> nLatsPerBlock, nAltsPerBlock) +!> 3. The number of lon/lats in a single grid block (nxPerBlock, +!> nyPerBlock, nzPerBlock) !> !> 4. The number of neutral species (and probably a mapping between !> the species number and the variable name) (nSpeciesTotal, nSpecies) @@ -726,21 +1012,27 @@ subroutine restart_files_to_netcdf(restart_dirname,netcdf_output_file) ncid = nc_create_file(netcdf_output_file) +! TODO: This should probably be replaced by nc_write_model_atts(ncid). +! That may require renaming some dimension variables. call add_nc_definitions(ncid) -call get_data(restart_dirname, ncid, define=.true.) +! TODO: restore after domains question is answered +! call get_data(restart_dirname, ncid, define=.true.) call nc_end_define_mode(ncid) ! TODO: This has not been activated because the functionality is in TIEGCM's nc_write_model_atts -! but maybe it shouldn't be. +! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying +! the state vector field names and source. ! call add_nc_dimvars(ncid) -call get_data(restart_dirname, ncid, define=.false.) +! TODO: restore after domains question is answered +! call get_data(restart_dirname, ncid, define=.false.) -call print_time(model_time) +call print_time(state_time) -call write_model_time(ncid, model_time) +! TODO: this needs to be updated to write to time.json, not a NetCDF file. +! call write_model_time(ncid, state_time) call nc_close_file(ncid) @@ -752,7 +1044,7 @@ subroutine add_nc_definitions(ncid) integer, intent(in) :: ncid -call nc_add_global_attribute(ncid, 'model', 'gitm') +call nc_add_global_attribute(ncid, 'model', 'aether') !------------------------------------------------------------------------------- ! Determine shape of most important namelist @@ -778,9 +1070,9 @@ subroutine add_nc_definitions(ncid) ! output only grid info - state vars will be written by other non-model_mod code !---------------------------------------------------------------------------- -call nc_define_dimension(ncid, LON_DIM_NAME, NgridLon) -call nc_define_dimension(ncid, LAT_DIM_NAME, NgridLat) -call nc_define_dimension(ncid, ALT_DIM_NAME, NgridAlt) +call nc_define_dimension(ncid, LON_DIM_NAME, nlon) +call nc_define_dimension(ncid, LAT_DIM_NAME, nlat) +call nc_define_dimension(ncid, ALT_DIM_NAME, nalt) call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? !---------------------------------------------------------------------------- @@ -821,489 +1113,502 @@ subroutine add_nc_definitions(ncid) end subroutine add_nc_definitions -!================================================================= -! open all restart files and read in the requested data item - -subroutine get_data(dirname, ncid, define) - -character(len=*), intent(in) :: dirname -integer, intent(in) :: ncid -logical, intent(in) :: define - -integer :: ibLoop, jbLoop -integer :: ib, jb, nb, iunit - -character(len=256) :: filename - -! get the dirname, construct the filenames inside open_block_file - -if (define) then - ! if define, run one block. - ! the read_data_from_block call defines the variables in the netCDF file. - ibLoop = 1 - jbLoop = 1 -else - ! if not define, run all blocks. - ! the read_data_from_block call adds the (ib,jb) block to a netCDF variable - ! in order to make a file containing the data for all the blocks. - ibLoop = nBlocksLon - jbLoop = nBlocksLat -end if - -do jb = 1, jbLoop - do ib = 1, ibLoop - nb = (jb-1) * nBlocksLon + ib - - iunit = open_block_file(dirname, nb, 'read', filename) - - call read_data_from_block(iunit, ib, jb, ncid, define) - - call close_file(iunit) - enddo -enddo - -end subroutine get_data - -!================================================================== - -!> open all restart files and read in the requested data items -!> -!> This is a two-pass method: first run through to define the NC variables -!> (define = .true.), then run again to write the data to the NC file -!> (define = .false.) - -subroutine read_data_from_block(iunit, ib, jb, ncid, define) - -integer, intent(in) :: iunit -integer, intent(in) :: ib, jb -integer, intent(in) :: ncid -logical, intent(in) :: define - -real(r8), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:), temp4d(:,:,:,:) -real(r8), allocatable :: alt1d(:), density_ion_e(:,:,:) -real(r8) :: temp0d !Alex: single parameter has "zero dimensions" -integer :: i, j, inum, maxsize, ivals(NSpeciesTotal) -integer :: block(2) = 0 - -logical :: no_idensity - -character(len=*), parameter :: routine = 'read_data_from_block' - -block(1) = ib -block(2) = jb - -! a temp array large enough to hold any of the -! Lon,Lat or Alt array from a block plus ghost cells -allocate(temp1d(1-nGhost:max(nLonsPerBlock,nLatsPerBlock,nAltsPerBlock)+nGhost)) -! treat alt specially since we want to derive TEC here -allocate( alt1d(1-nGhost:max(nLonsPerBlock,nLatsPerBlock,nAltsPerBlock)+nGhost)) - -! temp array large enough to hold any 2D field -allocate(temp2d(1-nGhost:nLonsPerBlock+nGhost, & - 1-nGhost:nLatsPerBlock+nGhost)) - -! temp array large enough to hold 1 species, temperature, etc -allocate(temp3d(1-nGhost:nLonsPerBlock+nGhost, & - 1-nGhost:nLatsPerBlock+nGhost, & - 1-nGhost:nAltsPerBlock+nGhost)) - -! save density_ion_e to compute TEC -allocate(density_ion_e(1-nGhost:nLonsPerBlock+nGhost, & - 1-nGhost:nLatsPerBlock+nGhost, & - 1-nGhost:nAltsPerBlock+nGhost)) - -! temp array large enough to hold velocity vect, etc -maxsize = max(3, nSpecies) -allocate(temp4d(1-nGhost:nLonsPerBlock+nGhost, & - 1-nGhost:nLatsPerBlock+nGhost, & - 1-nGhost:nAltsPerBlock+nGhost, maxsize)) - -! get past lon and lat arrays and read in alt array -read(iunit) temp1d(1-nGhost:nLonsPerBlock+nGhost) -read(iunit) temp1d(1-nGhost:nLatsPerBlock+nGhost) -! save the alt1d for later TEC computation -read(iunit) alt1d(1-nGhost:nAltsPerBlock+nGhost) - -! Read the index from the first species -call get_index_from_gitm_varname('NDensityS', inum, ivals) - -if (inum > 0) then - ! if i equals ival, use the data from the state vect - ! otherwise read/write what's in the input file - j = 1 - do i = 1, nSpeciesTotal - if (debug > 80) then - write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading species ',i,' of ',nSpeciesTotal, & - ' for block (',ib,',',jb,')' - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - read(iunit) temp3d - if (j <= inum) then - if (i == gitmvar(ivals(j))%gitm_index) then - call unpack_data(temp3d, ivals(j), block, ncid, define) - j = j + 1 - endif - endif - enddo -else - if (debug > 80) then - write(string1,'(A)') 'Not writing the NDensityS variables to file' - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - ! nothing at all from this variable in the state vector. - ! copy all data over from the input file to output file - do i = 1, nSpeciesTotal - read(iunit) temp3d - enddo -endif - -call get_index_from_gitm_varname('IDensityS', inum, ivals) - -! assume we could not find the electron density for VTEC calculations -no_idensity = .true. - -if (inum > 0) then - ! one or more items in the state vector need to replace the - ! data in the output file. loop over the index list in order. - j = 1 - do i = 1, nIons - if (debug > 80) then - write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & - ' for block (',ib,',',jb,')' - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - read(iunit) temp3d - if (j <= inum) then - if (i == gitmvar(ivals(j))%gitm_index) then - ! ie_, the gitm index for electron density, comes from ModEarth - if (gitmvar(ivals(j))%gitm_index == ie_) then - ! save the electron density for TEC computation - density_ion_e(:,:,:) = temp3d(:,:,:) - no_idensity = .false. - end if - ! read from input but write from state vector - call unpack_data(temp3d, ivals(j), block, ncid, define) - j = j + 1 - endif - endif - enddo -else - ! nothing at all from this variable in the state vector. - ! read past this variable - if (debug > 80) then - write(string1,'(A)') 'Not writing the IDensityS variables to file' - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - do i = 1, nIons - read(iunit) temp3d - enddo -endif - -read(iunit) temp3d -call get_index_from_gitm_varname('Temperature', inum, ivals) - -if (inum > 0) then - call unpack_data(temp3d, ivals(1), block, ncid, define) -endif - -read(iunit) temp3d -call get_index_from_gitm_varname('ITemperature', inum, ivals) -if (inum > 0) then - call unpack_data(temp3d, ivals(1), block, ncid, define) -endif - -read(iunit) temp3d -call get_index_from_gitm_varname('eTemperature', inum, ivals) -if (inum > 0) then - call unpack_data(temp3d, ivals(1), block, ncid, define) -endif - -read(iunit) temp4d(:,:,:,1:3) -call get_index_from_gitm_varname('Velocity', inum, ivals) -if (inum > 0) then - ! copy out any requested bits into state vector - j = 1 - do i = 1, 3 - if (j <= inum) then - if (i == gitmvar(ivals(j))%gitm_index) then - temp3d = temp4d(:,:,:,i) - call unpack_data(temp3d, ivals(j), block, ncid, define) - j = j + 1 - endif - endif - enddo -endif - -read(iunit) temp4d(:,:,:,1:3) -call get_index_from_gitm_varname('IVelocity', inum, ivals) -if (inum > 0) then - ! copy out any requested bits into state vector - j = 1 - do i = 1, 3 - if (j <= inum) then - if (i == gitmvar(ivals(j))%gitm_index) then - ! read from input but write from state vector - temp3d = temp4d(:,:,:,i) - call unpack_data(temp3d, ivals(j), block, ncid, define) - j = j + 1 - endif - endif - enddo -endif - -!print *, 'reading in temp4d for vvel' -read(iunit) temp4d(:,:,:,1:nSpecies) -call get_index_from_gitm_varname('VerticalVelocity', inum, ivals) -if (inum > 0) then - ! copy out any requested bits into state vector - j = 1 - do i = 1, nSpecies - if (j <= inum) then - if (i == gitmvar(ivals(j))%gitm_index) then - temp3d = temp4d(:,:,:,i) - call unpack_data(temp3d, ivals(j), block, ncid, define) - j = j + 1 - endif - endif - enddo -endif - -! add the VTEC as an extended-state variable -! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program -call get_index_from_gitm_varname('TEC', inum, ivals) - -if (inum > 0 .and. no_idensity) then - write(string1,*) 'Cannot compute the VTEC without the electron density' - call error_handler(E_ERR,routine,string1,source,revision,revdate) -end if - -if (inum > 0) then - if (.not. define) then - temp2d = 0._r8 - ! comptue the TEC integral - do i =1,nAltsPerBlock-1 ! approximate the integral over the altitude as a sum of trapezoids - ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 - temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 - end do - ! convert temp2d to TEC units - temp2d = temp2d/1e16_r8 - end if - call unpack_data2d(temp2d, ivals(1), block, ncid, define) -end if - -!alex begin -read(iunit) temp0d -!gitm_index = get_index_start(domain_id, 'VerticalVelocity') -call get_index_from_gitm_varname('f107', inum, ivals) -if (inum > 0) then - call unpack_data0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine -endif - -read(iunit) temp3d -call get_index_from_gitm_varname('Rho', inum, ivals) -if (inum > 0) then - call unpack_data(temp3d, ivals(1), block, ncid, define) -endif -!alex end - -!print *, 'calling dealloc' -deallocate(temp1d, temp2d, temp3d, temp4d) -deallocate(alt1d, density_ion_e) - -end subroutine read_data_from_block - -!================================================================= -! Determine where any data from a given gitm_varname lies in the -! DART state vector. - -subroutine get_index_from_gitm_varname(gitm_varname, inum, ivals) - -character(len=*), intent(in) :: gitm_varname -integer, intent(out) :: inum, ivals(:) - -integer :: gindex(nfields) -integer :: i, limit - -inum = 0 -limit = size(ivals) - -! GITM handles variables in a way that might seem strange at first. -! It uses the same name but multiple indices. For example, the U, V, -! and W components of wind are index = 1, 2, 3 for the variable velocity. -! This is why the code below looks the way it does. -FieldLoop : do i=1,nfields - if (gitmvar(i)%gitm_varname /= gitm_varname) cycle FieldLoop - inum = inum + 1 - if (inum > limit) then - write(string1,*) 'found too many matches, ivals needs to be larger than ', limit - call error_handler(E_ERR,'get_index_from_gitm_varname',string1,source,revision,revdate) - endif - ! i is index into gitmvar array - the order of the fields in the sv - ! gitm_index is index into the specific variable in the gitm restarts - ivals(inum) = i - gindex(inum) = gitmvar(i)%gitm_index -enddo FieldLoop - -!if (inum > 0) then -! print *, 'before sort, inum: ', inum -! print *, 'before sort, gindex: ', gindex(1:inum) -! print *, 'before sort, ivals: ', ivals(1:inum) -!endif - -! return the vals sorted by gitm_index order if more than 1 -if (inum > 1) call sortindexlist(gindex, ivals, inum) - -!if (inum > 0) then -! print *, 'after sort, inum: ', inum -! print *, 'after sort, gindex: ', gindex(1:inum) -! print *, 'after sort, ivals: ', ivals(1:inum) -!endif - -end subroutine get_index_from_gitm_varname - -!================================================================== - - -!> put the f107 estimate (a scalar, hence 0d) into the state vector. -!> Written specifically -!> for f107 since f107 is the same for all blocks. So what it does -!> is take f107 from the first block (block = 0) and disregard -!> f107 values from all other blocks (hopefully they are the same). -!> written by alex - -subroutine unpack_data0d(data0d, ivar, ncid, define) - -real(r8), intent(in) :: data0d -integer, intent(in) :: ivar ! index into state structure -integer, intent(in) :: ncid -logical, intent(in) :: define - - -character(len=*), parameter :: routine = 'unpack_data0d' - -if (define) then - - if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - - call nc_define_double_scalar(ncid, gitmvar(ivar)%varname) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) - -else - - call nc_put_variable(ncid, gitmvar(ivar)%varname, data0d, context=routine) - -end if - -end subroutine unpack_data0d - -!================================================================== - -! put the requested data into a netcdf variable - -subroutine unpack_data2d(data2d, ivar, block, ncid, define) - -real(r8), intent(in) :: data2d(1-nGhost:nLonsPerBlock+nGhost, & - 1-nGhost:nLatsPerBlock+nGhost) - -integer, intent(in) :: ivar ! variable index -integer, intent(in) :: block(2) -integer, intent(in) :: ncid -logical, intent(in) :: define - -integer :: ib, jb -integer :: starts(2) -character(len=*), parameter :: routine = 'unpack_data2d' - -if (define) then - - if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - - call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME /) ) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) - !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) - -else - ib = block(1) - jb = block(2) - - ! to compute the start, consider (ib-1)*nLonsPerBlock+1 - starts(1) = (ib-1)*nLonsPerBlock+1 - starts(2) = (jb-1)*nLatsPerBlock+1 - - call nc_put_variable(ncid, gitmvar(ivar)%varname, & - data2d(1:nLonsPerBlock,1:nLatsPerBlock), & - context=routine, nc_start=starts, & - nc_count=(/nLonsPerBlock,nLatsPerBlock/)) -end if - -end subroutine unpack_data2d - -!================================================================== - -! put the requested data into a netcdf variable - -subroutine unpack_data(data3d, ivar, block, ncid, define) - -real(r8), intent(in) :: data3d(1-nGhost:nLonsPerBlock+nGhost, & - 1-nGhost:nLatsPerBlock+nGhost, & - 1-nGhost:nAltsPerBlock+nGhost) - -integer, intent(in) :: ivar ! variable index -integer, intent(in) :: block(2) -integer, intent(in) :: ncid -logical, intent(in) :: define - -integer :: ib, jb -integer :: starts(3) -character(len=*), parameter :: routine = 'unpack_data' - -if (define) then - - if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - - call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME, ALT_DIM_NAME /) ) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) - !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) - call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) - -else - - ib = block(1) - jb = block(2) - - ! to compute the start, consider (ib-1)*nLonsPerBlock+1 - starts(1) = (ib-1)*nLonsPerBlock+1 - starts(2) = (jb-1)*nLatsPerBlock+1 - starts(3) = 1 - - call nc_put_variable(ncid, gitmvar(ivar)%varname, & - data3d(1:nLonsPerBlock,1:nLatsPerBlock,1:nAltsPerBlock), & - context=routine, nc_start=starts, & - nc_count=(/nLonsPerBlock,nLatsPerBlock,nAltsPerBlock/)) -end if - -end subroutine unpack_data - +! !================================================================= +! ! open all restart files and read in the requested data item +! +! subroutine get_data(dirname, ncid, define) +! +! character(len=*), intent(in) :: dirname +! integer, intent(in) :: ncid +! logical, intent(in) :: define +! +! integer :: ibLoop, jbLoop +! integer :: ib, jb, nb, iunit +! +! character(len=256) :: filename +! +! ! get the dirname, construct the filenames inside open_block_file +! +! if (define) then +! ! if define, run one block. +! ! the read_data_from_block call defines the variables in the whole domain netCDF file. +! ibLoop = 1 +! jbLoop = 1 +! else +! ! if not define, run all blocks. +! ! the read_data_from_block call adds the (ib,jb) block to a netCDF variable +! ! in order to make a file containing the data for all the blocks. +! ibLoop = nBlocksLon +! jbLoop = nBlocksLat +! end if +! +! ! TODO: loop over members somewhere +! ! including opening member files before getting data for them. +! do ft = 1,size(filetypes) Actually, loop over 2 domains? (somewhere) +! do jb = 1, jbLoop +! do ib = 1, ibLoop +! nb = (jb-1) * nBlocksLon + ib - 1 +! +! ! TODO; this is now an ncid. Update read_data_from_block to read from a NetCDF file. +! ncid = open_block_file(dirname, filetype(ft), mem, nb, 'read', filename) +! +! call nc_get_variable(ncid, 'Altitudes', temp, routine) +! +! call nc_close_file(ncid) +! +! ! iunit = open_block_file(dirname, nb, 'read', filename) +! ! +! ! call read_data_from_block(iunit, ib, jb, ncid, define) +! ! +! ! call close_file(iunit) +! enddo +! enddo +! enddo +! +! end subroutine get_data +! +! !================================================================== +! +! !> open all restart files and read in the requested data items +! !> +! !> This is a two-pass method: first run through to define the NC variables +! !> (define = .true.), then run again to write the data to the NC file +! !> (define = .false.) +! +! subroutine read_data_from_block(iunit, ib, jb, ncid, define) +! +! integer, intent(in) :: iunit +! integer, intent(in) :: ib, jb +! integer, intent(in) :: ncid +! logical, intent(in) :: define +! +! real(r8), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:), temp4d(:,:,:,:) +! real(r8), allocatable :: alt1d(:), density_ion_e(:,:,:) +! real(r8) :: temp0d !Alex: single parameter has "zero dimensions" +! integer :: i, j, inum, maxsize, ivals(NSpeciesTotal) +! integer :: block(2) = 0 +! +! logical :: no_idensity +! +! character(len=*), parameter :: routine = 'read_data_from_block' +! +! block(1) = ib +! block(2) = jb +! +! ! a temp array large enough to hold any of the +! ! Lon,Lat or Alt array from a block plus ghost cells +! allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) +! ! treat alt specially since we want to derive TEC here +! allocate( alt1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) +! +! ! temp array large enough to hold any 2D field +! allocate(temp2d(1-nGhost:nxPerBlock+nGhost, & +! 1-nGhost:nyPerBlock+nGhost)) +! +! ! temp array large enough to hold 1 species, temperature, etc +! allocate(temp3d(1-nGhost:nxPerBlock+nGhost, & +! 1-nGhost:nyPerBlock+nGhost, & +! 1-nGhost:nzPerBlock+nGhost)) +! +! ! save density_ion_e to compute TEC +! allocate(density_ion_e(1-nGhost:nxPerBlock+nGhost, & +! 1-nGhost:nyPerBlock+nGhost, & +! 1-nGhost:nzPerBlock+nGhost)) +! +! ! temp array large enough to hold velocity vect, etc +! maxsize = max(3, nSpecies) +! allocate(temp4d(1-nGhost:nxPerBlock+nGhost, & +! 1-nGhost:nyPerBlock+nGhost, & +! 1-nGhost:nzPerBlock+nGhost, maxsize)) +! +! ! get past lon and lat arrays and read in alt array +! read(iunit) temp1d(1-nGhost:nxPerBlock+nGhost) +! read(iunit) temp1d(1-nGhost:nyPerBlock+nGhost) +! ! save the alt1d for later TEC computation +! read(iunit) alt1d(1-nGhost:nzPerBlock+nGhost) +! +! ! Read the index from the first species +! call get_index_from_gitm_varname('NDensityS', inum, ivals) +! +! if (inum > 0) then +! ! if i equals ival, use the data from the state vect +! ! otherwise read/write what's in the input file +! j = 1 +! do i = 1, nSpeciesTotal +! if (debug > 80) then +! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading species ',i,' of ',nSpeciesTotal, & +! ' for block (',ib,',',jb,')' +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! read(iunit) temp3d +! if (j <= inum) then +! if (i == gitmvar(ivals(j))%gitm_index) then +! call unpack_data(temp3d, ivals(j), block, ncid, define) +! j = j + 1 +! endif +! endif +! enddo +! else +! if (debug > 80) then +! write(string1,'(A)') 'Not writing the NDensityS variables to file' +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! ! nothing at all from this variable in the state vector. +! ! copy all data over from the input file to output file +! do i = 1, nSpeciesTotal +! read(iunit) temp3d +! enddo +! endif +! +! call get_index_from_gitm_varname('IDensityS', inum, ivals) +! +! ! assume we could not find the electron density for VTEC calculations +! no_idensity = .true. +! +! if (inum > 0) then +! ! one or more items in the state vector need to replace the +! ! data in the output file. loop over the index list in order. +! j = 1 +! ! TODO: In Aether they're from an ions file. +! do i = 1, nIons +! if (debug > 80) then +! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & +! ' for block (',ib,',',jb,')' +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! read(iunit) temp3d +! if (j <= inum) then +! if (i == gitmvar(ivals(j))%gitm_index) then +! ! ie_, the gitm index for electron density, comes from ModEarth +! if (gitmvar(ivals(j))%gitm_index == ie_) then +! ! save the electron density for TEC computation +! density_ion_e(:,:,:) = temp3d(:,:,:) +! no_idensity = .false. +! end if +! ! read from input but write from state vector +! call unpack_data(temp3d, ivals(j), block, ncid, define) +! j = j + 1 +! endif +! endif +! enddo +! else +! ! nothing at all from this variable in the state vector. +! ! read past this variable +! if (debug > 80) then +! write(string1,'(A)') 'Not writing the IDensityS variables to file' +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! do i = 1, nIons +! read(iunit) temp3d +! enddo +! endif +! +! ! TODO: Neutrals? In Aether they're from a different file. +! read(iunit) temp3d +! call get_index_from_gitm_varname('Temperature', inum, ivals) +! +! if (inum > 0) then +! call unpack_data(temp3d, ivals(1), block, ncid, define) +! endif +! +! read(iunit) temp3d +! call get_index_from_gitm_varname('ITemperature', inum, ivals) +! if (inum > 0) then +! call unpack_data(temp3d, ivals(1), block, ncid, define) +! endif +! +! read(iunit) temp3d +! call get_index_from_gitm_varname('eTemperature', inum, ivals) +! if (inum > 0) then +! call unpack_data(temp3d, ivals(1), block, ncid, define) +! endif +! +! read(iunit) temp4d(:,:,:,1:3) +! call get_index_from_gitm_varname('Velocity', inum, ivals) +! if (inum > 0) then +! ! copy out any requested bits into state vector +! j = 1 +! do i = 1, 3 +! if (j <= inum) then +! if (i == gitmvar(ivals(j))%gitm_index) then +! temp3d = temp4d(:,:,:,i) +! call unpack_data(temp3d, ivals(j), block, ncid, define) +! j = j + 1 +! endif +! endif +! enddo +! endif +! +! read(iunit) temp4d(:,:,:,1:3) +! call get_index_from_gitm_varname('IVelocity', inum, ivals) +! if (inum > 0) then +! ! copy out any requested bits into state vector +! j = 1 +! do i = 1, 3 +! if (j <= inum) then +! if (i == gitmvar(ivals(j))%gitm_index) then +! ! read from input but write from state vector +! temp3d = temp4d(:,:,:,i) +! call unpack_data(temp3d, ivals(j), block, ncid, define) +! j = j + 1 +! endif +! endif +! enddo +! endif +! +! !print *, 'reading in temp4d for vvel' +! read(iunit) temp4d(:,:,:,1:nSpecies) +! call get_index_from_gitm_varname('VerticalVelocity', inum, ivals) +! if (inum > 0) then +! ! copy out any requested bits into state vector +! j = 1 +! do i = 1, nSpecies +! if (j <= inum) then +! if (i == gitmvar(ivals(j))%gitm_index) then +! temp3d = temp4d(:,:,:,i) +! call unpack_data(temp3d, ivals(j), block, ncid, define) +! j = j + 1 +! endif +! endif +! enddo +! endif +! +! ! add the VTEC as an extended-state variable +! ! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program +! call get_index_from_gitm_varname('TEC', inum, ivals) +! +! if (inum > 0 .and. no_idensity) then +! write(string1,*) 'Cannot compute the VTEC without the electron density' +! call error_handler(E_ERR,routine,string1,source,revision,revdate) +! end if +! +! if (inum > 0) then +! if (.not. define) then +! temp2d = 0._r8 +! ! comptue the TEC integral +! do i =1,nzPerBlock-1 ! approximate the integral over the altitude as a sum of trapezoids +! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 +! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 +! end do +! ! convert temp2d to TEC units +! temp2d = temp2d/1e16_r8 +! end if +! call unpack_data2d(temp2d, ivals(1), block, ncid, define) +! end if +! +! !alex begin +! read(iunit) temp0d +! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') +! call get_index_from_gitm_varname('f107', inum, ivals) +! if (inum > 0) then +! call unpack_data0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine +! endif +! +! read(iunit) temp3d +! call get_index_from_gitm_varname('Rho', inum, ivals) +! if (inum > 0) then +! call unpack_data(temp3d, ivals(1), block, ncid, define) +! endif +! !alex end +! +! !print *, 'calling dealloc' +! deallocate(temp1d, temp2d, temp3d, temp4d) +! deallocate(alt1d, density_ion_e) +! +! end subroutine read_data_from_block +! +! !================================================================= +! ! Determine where any data from a given gitm_varname lies in the +! ! DART state vector. +! +! subroutine get_index_from_gitm_varname(gitm_varname, inum, ivals) +! +! character(len=*), intent(in) :: gitm_varname +! integer, intent(out) :: inum, ivals(:) +! +! integer :: gindex(nfields) +! integer :: i, limit +! +! inum = 0 +! limit = size(ivals) +! +! ! GITM handles variables in a way that might seem strange at first. +! ! It uses the same name but multiple indices. For example, the U, V, +! ! and W components of wind are index = 1, 2, 3 for the variable velocity. +! ! This is why the code below looks the way it does. +! FieldLoop : do i=1,nfields +! if (gitmvar(i)%gitm_varname /= gitm_varname) cycle FieldLoop +! inum = inum + 1 +! if (inum > limit) then +! write(string1,*) 'found too many matches, ivals needs to be larger than ', limit +! call error_handler(E_ERR,'get_index_from_gitm_varname',string1,source,revision,revdate) +! endif +! ! i is index into gitmvar array - the order of the fields in the sv +! ! gitm_index is index into the specific variable in the gitm restarts +! ivals(inum) = i +! gindex(inum) = gitmvar(i)%gitm_index +! enddo FieldLoop +! +! !if (inum > 0) then +! ! print *, 'before sort, inum: ', inum +! ! print *, 'before sort, gindex: ', gindex(1:inum) +! ! print *, 'before sort, ivals: ', ivals(1:inum) +! !endif +! +! ! return the vals sorted by gitm_index order if more than 1 +! if (inum > 1) call sortindexlist(gindex, ivals, inum) +! +! !if (inum > 0) then +! ! print *, 'after sort, inum: ', inum +! ! print *, 'after sort, gindex: ', gindex(1:inum) +! ! print *, 'after sort, ivals: ', ivals(1:inum) +! !endif +! +! end subroutine get_index_from_gitm_varname +! +! !================================================================== +! +! +! !> put the f107 estimate (a scalar, hence 0d) into the state vector. +! !> Written specifically +! !> for f107 since f107 is the same for all blocks. So what it does +! !> is take f107 from the first block (block = 0) and disregard +! !> f107 values from all other blocks (hopefully they are the same). +! !> written by alex +! +! subroutine unpack_data0d(data0d, ivar, ncid, define) +! +! real(r8), intent(in) :: data0d +! integer, intent(in) :: ivar ! index into state structure +! integer, intent(in) :: ncid +! logical, intent(in) :: define +! +! +! character(len=*), parameter :: routine = 'unpack_data0d' +! +! if (define) then +! +! if (debug > 10) then +! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! +! call nc_define_double_scalar(ncid, gitmvar(ivar)%varname) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) +! +! else +! +! call nc_put_variable(ncid, gitmvar(ivar)%varname, data0d, context=routine) +! +! end if +! +! end subroutine unpack_data0d +! +! !================================================================== +! +! ! put the requested data into a netcdf variable +! +! subroutine unpack_data2d(data2d, ivar, block, ncid, define) +! +! real(r8), intent(in) :: data2d(1-nGhost:nxPerBlock+nGhost, & +! 1-nGhost:nyPerBlock+nGhost) +! +! integer, intent(in) :: ivar ! variable index +! integer, intent(in) :: block(2) +! integer, intent(in) :: ncid +! logical, intent(in) :: define +! +! integer :: ib, jb +! integer :: starts(2) +! character(len=*), parameter :: routine = 'unpack_data2d' +! +! if (define) then +! +! if (debug > 10) then +! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! +! call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME /) ) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) +! !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) +! +! else +! ib = block(1) +! jb = block(2) +! +! ! to compute the start, consider (ib-1)*nxPerBlock+1 +! starts(1) = (ib-1)*nxPerBlock+1 +! starts(2) = (jb-1)*nyPerBlock+1 +! +! call nc_put_variable(ncid, gitmvar(ivar)%varname, & +! data2d(1:nxPerBlock,1:nyPerBlock), & +! context=routine, nc_start=starts, & +! nc_count=(/nxPerBlock,nyPerBlock/)) +! end if +! +! end subroutine unpack_data2d +! +! !================================================================== +! +! ! put the requested data into a netcdf variable +! +! subroutine unpack_data(data3d, ivar, block, ncid, define) +! +! real(r8), intent(in) :: data3d(1-nGhost:nxPerBlock+nGhost, & +! 1-nGhost:nyPerBlock+nGhost, & +! 1-nGhost:nzPerBlock+nGhost) +! +! integer, intent(in) :: ivar ! variable index +! integer, intent(in) :: block(2) +! integer, intent(in) :: ncid +! logical, intent(in) :: define +! +! integer :: ib, jb +! integer :: starts(3) +! character(len=*), parameter :: routine = 'unpack_data' +! +! if (define) then +! +! if (debug > 10) then +! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! +! call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME, ALT_DIM_NAME /) ) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) +! !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) +! +! else +! +! ib = block(1) +! jb = block(2) +! +! ! to compute the start, consider (ib-1)*nxPerBlock+1 +! starts(1) = (ib-1)*nxPerBlock+1 +! starts(2) = (jb-1)*nyPerBlock+1 +! starts(3) = 1 +! +! call nc_put_variable(ncid, gitmvar(ivar)%varname, & +! data3d(1:nxPerBlock,1:nyPerBlock,1:nzPerBlock), & +! context=routine, nc_start=starts, & +! nc_count=(/nxPerBlock,nyPerBlock,nzPerBlock/)) +! end if +! +! end subroutine unpack_data +! !================================================================= !> sort list x into order based on values in list. @@ -1429,7 +1734,7 @@ subroutine model_interpolate(state_handle, ens_size, location, iqty, obs_val, is ! use plevs vs. pilevs ! Check to make sure vertical level is possible. - if ((level < 1) .or. (level > nlev)) then + if ((level < 1) .or. (level > nalt)) then istatus(:) = 33 return else @@ -1578,8 +1883,8 @@ subroutine get_state_meta_data(index_in, location, var_qty) select case (trim(dim_name)) case ('ilev') location = set_location(lons(lon_index), lats(lat_index), ilevs(lev_index), VERTISLEVEL) - case ('lev') - location = set_location(lons(lon_index), lats(lat_index), levs(lev_index), VERTISLEVEL) + case (ALT_DIM_NAME) + location = set_location(lons(lon_index), lats(lat_index), alts(lev_index), VERTISLEVEL) case default call error_handler(E_ERR, 'get_state_meta_data', 'expecting ilev or ilat dimension') ! HK @todo 2D variables. @@ -1617,30 +1922,31 @@ subroutine nc_write_model_atts( ncid, dom_id ) ! define grid dimensions -call nc_define_dimension(ncid, 'lon', nlon, routine) -call nc_define_dimension(ncid, 'lat', nlat, routine) -call nc_define_dimension(ncid, 'lev', all_nlev, routine) +call nc_define_dimension(ncid, LON_DIM_NAME, nlon, routine) +call nc_define_dimension(ncid, LAT_DIM_NAME, nlat, routine) +call nc_define_dimension(ncid, ALT_DIM_NAME, all_nalt, routine) call nc_define_dimension(ncid, 'ilev', nilev, routine) ! define grid variables ! longitude -call nc_define_real_variable( ncid, 'lon', (/ 'lon' /), routine) -call nc_add_attribute_to_variable(ncid, 'lon', 'long_name', 'geographic longitude (-west, +east)', routine) -call nc_add_attribute_to_variable(ncid, 'lon', 'units', 'degrees_east', routine) +call nc_define_real_variable( ncid, LON_DIM_NAME, (/ LON_DIM_NAME /), routine) +call nc_add_attribute_to_variable(ncid, LON_DIM_NAME, 'long_name', 'geographic longitude (-west, +east)', routine) +call nc_add_attribute_to_variable(ncid, LON_DIM_NAME, 'units', 'degrees_east', routine) ! latitude -call nc_define_real_variable( ncid, 'lat', (/ 'lat' /), routine) -call nc_add_attribute_to_variable(ncid, 'lat', 'long_name', 'geographic latitude (-south, +north)', routine) -call nc_add_attribute_to_variable(ncid, 'lat', 'units', 'degrees_north', routine) +call nc_define_real_variable( ncid, LAT_DIM_NAME, (/ LAT_DIM_NAME /), routine) +call nc_add_attribute_to_variable(ncid, LAT_DIM_NAME, 'long_name', 'geographic latitude (-south, +north)', routine) +call nc_add_attribute_to_variable(ncid, LAT_DIM_NAME, 'units', 'degrees_north', routine) -! levs -call nc_define_real_variable( ncid, 'lev', (/ 'lev' /), routine) -call nc_add_attribute_to_variable(ncid, 'lev', 'long_name', 'midpoint levels', routine) -call nc_add_attribute_to_variable(ncid, 'lev', 'short name', 'ln(p0/p)', routine) -call nc_add_attribute_to_variable(ncid, 'lev', 'positive', 'up', routine) -call nc_add_attribute_to_variable(ncid, 'lev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) -call nc_add_attribute_to_variable(ncid, 'lev', 'formula_terms', 'p0: p0 lev: lev', routine) -call nc_add_attribute_to_variable(ncid, 'lev', 'formula', 'p(k) = p0 * exp(-lev(k))', routine) +! alts +call nc_define_real_variable( ncid, ALT_DIM_NAME, (/ ALT_DIM_NAME /), routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'long_name', 'midpoint levels', routine) +! TODO: vert coord is altitude, not ... +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'short name', 'ln(p0/p)', routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'positive', 'up', routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula_terms', 'p0: p0 lev: lev', routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-lev(k))', routine) ! ilevs @@ -1650,7 +1956,8 @@ subroutine nc_write_model_atts( ncid, dom_id ) call nc_add_attribute_to_variable(ncid, 'ilev', 'positive', 'up', routine) call nc_add_attribute_to_variable(ncid, 'ilev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) call nc_add_attribute_to_variable(ncid, 'ilev', 'formula_terms', 'p0: p0 lev: ilev', routine) -call nc_add_attribute_to_variable(ncid, 'lev', 'formula', 'p(k) = p0 * exp(-ilev(k))', routine) +! TODO: Is there an interface alt? +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-ilev(k))', routine) call nc_end_define_mode(ncid, routine) @@ -1670,9 +1977,9 @@ subroutine nc_write_model_atts( ncid, dom_id ) ! ! Fill the coordinate variables ! !---------------------------------------------------------------------------- ! -! call nc_put_variable(ncid, LON_VAR_NAME, LON) -! call nc_put_variable(ncid, LAT_VAR_NAME, LAT) -! call nc_put_variable(ncid, ALT_VAR_NAME, ALT) +! call nc_put_variable(ncid, LON_VAR_NAME, lons) +! call nc_put_variable(ncid, LAT_VAR_NAME, lats) +! call nc_put_variable(ncid, ALT_VAR_NAME, alts) ! ! what about WL? ! ! !if (has_gitm_namelist) then @@ -1694,9 +2001,9 @@ subroutine nc_write_model_atts( ncid, dom_id ) allocate(temp_lons(nlon)) temp_lons = lons where (temp_lons >= 180.0_r8) temp_lons = temp_lons - 360.0_r8 -call nc_put_variable(ncid, 'lon', temp_lons, routine) -call nc_put_variable(ncid, 'lat', lats, routine) -call nc_put_variable(ncid, 'lev', all_levs, routine) +call nc_put_variable(ncid, LON_VAR_NAME, temp_lons, routine) +call nc_put_variable(ncid, LAT_VAR_NAME, lats, routine) +call nc_put_variable(ncid, ALT_VAR_NAME, all_alts, routine) call nc_put_variable(ncid, 'ilev', ilevs, routine) deallocate(temp_lons) @@ -1851,7 +2158,7 @@ subroutine convert_vertical_state(state_handle, num, locs, loc_qtys, loc_indx, & domain_id(SECONDARY_DOM), ivarZG) height = get_state(height_idx, state_handle)/100.0_r8 - case ('lev') ! height on midpoint + case (ALT_DIM_NAME) ! height on midpoint height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & domain_id(SECONDARY_DOM), ivarZG) height1 = get_state(height_idx, state_handle)/100.0_r8 @@ -1871,6 +2178,8 @@ subroutine convert_vertical_state(state_handle, num, locs, loc_qtys, loc_indx, & end subroutine convert_vertical_state !------------------------------------------------------------------------------- +! Called from static_init_model. +! TODO: probably needs to be updated as get_state_time, which is called by static_init_blocks. function read_model_time(filename) character(len=*), intent(in) :: filename @@ -1889,7 +2198,7 @@ function read_model_time(filename) ncid = nc_open_file_readonly(filename, routine) time_dimlen = nc_get_dimension_size(ncid, 'time', routine) -dimlen = nc_get_dimension_size(ncid, 'mtimedim', routine) +dimlen = nc_get_dimension_size(ncid, 'mtimedim', routine) if (dimlen /= nmtime) then write(string1, *) trim(filename), ' mtimedim = ',dimlen, ' DART expects ', nmtime @@ -1932,7 +2241,7 @@ subroutine read_TIEGCM_definition(file_name) ! fills metadata storage variables: ! lons(:), nlon ! lats(:), nlat -! lev(:), nlev +! lev(:), nalt ! ilev(:), nilev ! plevs(:) ! pilevs(:) @@ -1950,29 +2259,31 @@ subroutine read_TIEGCM_definition(file_name) ncid = nc_open_file_readonly(file_name, routine) ! longitude - TIEGCM uses values +/- 180, DART uses values [0,360] -nlon = nc_get_dimension_size(ncid, 'lon', routine) +nlon = nc_get_dimension_size(ncid, LON_DIM_NAME, routine) allocate(lons(nlon)) -call nc_get_variable(ncid, 'lon', lons, routine) +call nc_get_variable(ncid, LON_DIM_NAME, lons, routine) where (lons < 0.0_r8) lons = lons + 360.0_r8 ! latitiude -nlat = nc_get_dimension_size(ncid, 'lat', routine) +nlat = nc_get_dimension_size(ncid, LAT_DIM_NAME, routine) allocate(lats(nlat)) -call nc_get_variable(ncid, 'lat', lats, routine) +call nc_get_variable(ncid, LAT_DIM_NAME, lats, routine) ! pressure call nc_get_variable(ncid, 'p0', p0, routine) TIEGCM_reference_pressure = p0 ! level -all_nlev = nc_get_dimension_size(ncid, 'lev', routine) +all_nalt = nc_get_dimension_size(ncid, ALT_DIM_NAME, routine) ! top level is not viable. The lower boundary condition is stored in the top level -nlev = all_nlev - 1 -allocate(all_levs(all_nlev),levs(nlev), plevs(nlev)) -call nc_get_variable(ncid, 'lev', all_levs, routine) +nalt = all_nalt - 1 +allocate(all_alts(all_nalt),alts(nalt), plevs(nalt)) +call nc_get_variable(ncid, ALT_DIM_NAME, all_alts, routine) -levs=all_levs(1:nlev) -plevs = p0 * exp(-levs) * 100.0_r8 ![Pa] = 100* [millibars] = 100* [hPa] +alts=all_alts(1:nalt) +! TODO: in tiegcm levs was assumed to be pressure, but aether uses altitude, +! so this should probably be plevs; derive it from alts. +plevs = p0 * exp(-plevs) * 100.0_r8 ![Pa] = 100* [millibars] = 100* [hPa] ! ilevel nilev = nc_get_dimension_size(ncid, 'ilev', routine) @@ -1981,9 +2292,9 @@ subroutine read_TIEGCM_definition(file_name) pilevs = p0 * exp(-ilevs) * 100.0_r8 ! [Pa] = 100* [millibars] = 100* [hPa] -if ((nlev+1) .ne. nilev) then +if ((nalt+1) .ne. nilev) then write(string1,*) 'number of midpoints should be 1 less than number of interfaces.' !HK is the top level for nilev not a boundary condition? - write(string2,*) 'number of midpoints is nlev = ',nlev + write(string2,*) 'number of midpoints is nalt = ',nalt write(string3,*) 'number of interfaces is nilev = ',nilev call error_handler(E_MSG,'read_TIEGCM_definition', string1, & source, revision, revdate, text2=string2, text3=string3) @@ -2005,6 +2316,9 @@ end subroutine read_TIEGCM_definition ! TODO: this TIEGCM (generic DART subr?) is kept in preference to gitm's set_gitm_variable_info, ! but we need to check the functionality, esp. the domains at the end. +! Do we need to read in "variables" from somewhere and then translate into variable_table? +! Or can the model_nml namelist read _table directly? +! Maybe 2D arrays in namelists don't work; read 1D and translate to 2D ! Fill up the variable_table from the namelist item 'variables' ! The namelist item variables is where a user specifies @@ -2124,8 +2438,8 @@ subroutine verify_variables() ! ! end subroutine set_gitm_variable_info -call load_up_state_structure_from_file(tiegcm_restart_file_name, nfields_restart, 'RESTART', RESTART_DOM) -call load_up_state_structure_from_file(tiegcm_secondary_file_name, nfields_secondary, 'SECONDARY', SECONDARY_DOM) +call load_up_state_structure_from_file(aether_restart_file_name, nfields_restart, 'RESTART', RESTART_DOM) +call load_up_state_structure_from_file(aether_secondary_file_name, nfields_secondary, 'SECONDARY', SECONDARY_DOM) if (estimate_f10_7) then if (nfields_constructed == 0) then @@ -2190,7 +2504,7 @@ subroutine load_up_state_structure_from_file(filename, nvar, domain_name, domain var_names, kind_list, clamp_vals, update_list) ! remove top level from all lev variables - this is the boundary condition -call hyperslice_domain(domain_id(domain_num), 'lev', nlev) +call hyperslice_domain(domain_id(domain_num), ALT_DIM_NAME, nalt) deallocate(var_names, kind_list, clamp_vals, update_list) @@ -2219,25 +2533,25 @@ subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) real(r8), PARAMETER :: omass = 2.678e-26_r8 ! mass of atomic oxgen kg real(r8) :: earth_radiusm -integer :: nlevX, nilevX, j, i, var_id +integer :: naltX, nilevX, j, i, var_id integer(i8) :: idx ! NE,ZG are extrapolated ! 20 more layers for 2.5 degree resolution ! 10 more layers for 5 degree resolution if (model_res == 2.5) then - nlevX = nlev + 20 + naltX = nalt + 20 nilevX = nilev + 20 else - nlevX = nlev + 10 + naltX = nalt + 10 nilevX = nilev + 10 endif allocate( NE(nilev, ens_size), NEm_extended(nilevX, ens_size), & ZG(nilev, ens_size), ZG_extended(nilevX, ens_size)) -allocate( TI(nlev, ens_size), TE(nlev, ens_size) ) -allocate( delta_ZG(nlevX-1, ens_size), NE_middle(nlevX-1, ens_size) ) +allocate( TI(nalt, ens_size), TE(nalt, ens_size) ) +allocate( delta_ZG(naltX-1, ens_size), NE_middle(naltX-1, ens_size) ) ! NE (interfaces) var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'NE') @@ -2256,7 +2570,7 @@ subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) ! TI (midpoints) var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TI') -do i = 1, nlev +do i = 1, nalt idx = get_dart_vector_index(lon_index,lat_index, i, & domain_id(RESTART_DOM), var_id) TI(i, :) = get_state(idx, state_handle) @@ -2264,7 +2578,7 @@ subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) ! TE (midpoints) var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TE') -do i = 1, nlev +do i = 1, nalt idx = get_dart_vector_index(lon_index,lat_index, i, & domain_id(RESTART_DOM), var_id) TE(i, :) = get_state(idx, state_handle) @@ -2279,7 +2593,7 @@ subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) GRAVITYtop(:) = gravity * (earth_radiusm / (earth_radiusm + ZG(nilev,:))) ** 2 ! Plasma Temperature -Tplasma(:) = (TI(nlev-1,:) + TE(nlev-1,:)) / 2.0_r8 +Tplasma(:) = (TI(nalt-1,:) + TE(nalt-1,:)) / 2.0_r8 ! Compute plasma scale height Hplasma(:) = (2.0_r8 * k_constant / omass ) * Tplasma(:) / GRAVITYtop(:) @@ -2287,13 +2601,13 @@ subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) ZG_extended(1:nilev,:) = ZG NEm_extended(1:nilev,:) = NE -do j = nlev, nlevX +do j = nalt, naltX NEm_extended(j,:) = NEm_extended(j-1,:) * exp(-0.5_r8) ZG_extended(j,:) = ZG_extended(j-1,:) + Hplasma(:) / 2.0_r8 enddo -delta_ZG(1:(nlevX-1),:) = ZG_extended(2:nlevX,:) - ZG_extended(1:(nlevX-1),:) -NE_middle(1:(nlevX-1),:) = (NEm_extended(2:nlevX,:) + NEm_extended(1:(nlevX-1),:)) / 2.0_r8 +delta_ZG(1:(naltX-1),:) = ZG_extended(2:naltX,:) - ZG_extended(1:(naltX-1),:) +NE_middle(1:(naltX-1),:) = (NEm_extended(2:naltX,:) + NEm_extended(1:(naltX-1),:)) / 2.0_r8 do i = 1, ens_size vTEC(i) = sum(NE_middle(:,i) * delta_ZG(:,i)) * 1.0e-16_r8 ! Convert to TECU (1.0e+16 #/m^2) @@ -2340,7 +2654,7 @@ subroutine vert_interp(state_handle, n, dom_id, var_id, lon_index, lat_index, he if (vertstagger == 'ilev') then call vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pressure, & dom_id, var_id, val, istatus) -elseif (vertstagger == 'lev') then +elseif (vertstagger == ALT_DIM_NAME) then call vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & dom_id, var_id, val, istatus) endif @@ -2568,7 +2882,7 @@ subroutine vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pre (get_state(get_dart_vector_index(lon_index,lat_index,2, & domain_id(SECONDARY_DOM), ivarZG), state_handle) /100.0_r8) ) / 2.0_r8 - !mid_level nlev + !mid_level nalt zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,nilev-1, & domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & (get_state(get_dart_vector_index(lon_index,lat_index,nilev, & @@ -2708,7 +3022,7 @@ function ilev_or_lev(dom_id, var_id) result(dim_name) dim_name = 'null' do d = 1, get_num_dims(dom_id, var_id) dim_name = get_dim_name(dom_id, var_id, d) - if (dim_name == 'ilev' .or. dim_name == 'lev') exit + if (dim_name == 'ilev' .or. dim_name == ALT_DIM_NAME) exit enddo end function ilev_or_lev From a3b3004dd2051dd6dd426a59bfcf458816b019c9 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 27 Oct 2023 09:40:29 -0600 Subject: [PATCH 047/124] Activated read of restart and reformat into filter_input.nc Adapted code to handle the restart files' fields having C ordering. The filter_input.nc will use the same order, to avoid transposes. Replaced gitm's field-by-field code with loops over fields read from model_mod_nml. Made code capable of handling subdomains in the vertical, without halos. Moved definition of filter_input.nc fields from the unpack_data up to the fields loop in read_data_from_block, where it still doesn't fit with the subroutine name. Made code write whole domain data to a filter_input.nc. Aether_to_dart compiles, runs, and the filter_input.nc appears to have the blocks combined in the right order. This commit does not: include dart_to_aether code to read a filter_output.nc and divide it into block files have the extraneous code and comments taken out. get grid info from model_mod_nml instead of the UAM.in text file. allow interspersing of neutral and ion fields in the model_mod_nml variable list. implement handling of e- or f10_7 Modified: aether_to_dart.f90 Read member number from standard input (script) and pass to restart_files_to_netcdf. aether_to_dart.nml Added full pathname to aether_restart_input_dirname model_mod.f90 See above Read time from a restart file and assimilation_period from model_mod_nml instead of from time.json. Adapt "domains" feature to specify the source file of each of the fields, in model_mod_nml. Change name of read_data_from_block to reflect definition of output and integration of blocks? model_mod.f90 Replaced gitm's plain fields list with variable_table contents. Specified the source file_root of each field; 'neutrals' or 'ions'. Replace file name variables with filter_inout_dir. Added calendar and assimilation_period. --- models/aether_lon-lat/aether_to_dart.f90 | 20 +- models/aether_lon-lat/aether_to_dart.nml | 2 +- models/aether_lon-lat/model_mod.f90 | 978 ++++++++++++----------- models/aether_lon-lat/model_mod.nml | 35 +- models/aether_lon-lat/work/input.nml | 70 +- 5 files changed, 573 insertions(+), 532 deletions(-) diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index 697611bf2d..6d5ae26de8 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -12,6 +12,11 @@ program aether_to_dart ! method: Read aether "restart" files of model state (multiple files, ! one block per aether mpi task) ! Reform fields into a DART netcdf file +! TODO: Should this be an MPI program so that all members can be done at once? +! Get the ensemble size from input.nml:filter_nml. +! Can I send each member to a different node, so that the restart files +! could all be read at once on separate processors, and still be local +! to the member's filter_input.nc? ! ! USAGE: The aether restart dirname and output filename are read from ! the aether_to_dart_nml namelist. @@ -44,6 +49,8 @@ program aether_to_dart !----------------------------------------------------------------------- character(len=256) :: aether_restart_input_dirname = 'none' +! TODO: the calling script will need to move this to a name with $member in it, +! or use filter_nml:input_state_file_list character(len=256) :: aether_to_dart_output_file = 'filter_input.nc' namelist /aether_to_dart_nml/ aether_restart_input_dirname, & @@ -53,7 +60,7 @@ program aether_to_dart ! global storage !---------------------------------------------------------------------- -integer :: iunit, io +integer :: iunit, io, member !====================================================================== @@ -67,6 +74,14 @@ program aether_to_dart read(iunit, nml = aether_to_dart_nml, iostat = io) call check_namelist_read(iunit, io, "aether_to_dart_nml") ! closes, too. +!---------------------------------------------------------------------- +! Get the ensemble member +! TODO: The script must echo the member number to the aether_to_dart. +!---------------------------------------------------------------------- +member = -88 +read '(I3)', member +print*,'aether_to_dart: member = ',member + !---------------------------------------------------------------------- ! Convert the files !---------------------------------------------------------------------- @@ -78,7 +93,8 @@ program aether_to_dart call error_handler(E_MSG, program_name, string1, text2=string2) call error_handler(E_MSG, '', '') -call restart_files_to_netcdf(aether_restart_input_dirname, aether_to_dart_output_file) +call restart_files_to_netcdf(aether_restart_input_dirname, member, & + aether_to_dart_output_file) call error_handler(E_MSG, '', '') write(string1,*) 'Successfully converted the GITM restart files to ', & diff --git a/models/aether_lon-lat/aether_to_dart.nml b/models/aether_lon-lat/aether_to_dart.nml index c51c95888e..cc9c542b53 100644 --- a/models/aether_lon-lat/aether_to_dart.nml +++ b/models/aether_lon-lat/aether_to_dart.nml @@ -1,5 +1,5 @@ &aether_to_dart_nml - aether_restart_input_dirname = 'testdata1/restartOut.Sphere.1member' + aether_restart_input_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' aether_to_dart_output_file = 'filter_input.nc' / diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index d627b5edbc..192374311d 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -54,6 +54,7 @@ module model_mod do_nml_file, do_nml_term, register_module, & file_to_text, find_textfile_dims, to_upper +! TODO: will need many more kinds, and maybe new kinds (6 velocity components, ...?) use obs_kind_mod, only : QTY_U_WIND_COMPONENT, & QTY_V_WIND_COMPONENT, & QTY_TEMPERATURE, &! neutral temperature obs @@ -63,6 +64,7 @@ module model_mod QTY_GEOPOTENTIAL_HEIGHT, & QTY_GEOMETRIC_HEIGHT, & QTY_VERTICAL_TEC, &! total electron content + QTY_DENSITY_ION_OP, &! O+ get_index_for_quantity use quad_utils_mod, only : quad_interp_handle, init_quad_interp, & @@ -148,19 +150,24 @@ module model_mod !------------------------------------------------------------------------------- ! namelist with default values +! TODO: Define a derived type to handle the file types which need to be read andor written? +! PRobably not; variable_table probably handles it all. +! file_root {'neutrals','ions', 'time', f10_7? ...?) +! file_ext {'nc', 'nc', 'json', 'nc', ...) +! num_fields {nfields_neutral, nfields_ion, 2, ?, ...) +! character(len=8), dimension(2) :: file_root = /('neutrals','ions'/) -character(len=256) :: aether_restart_file_name = 'aether_restart_p.nc' -character(len=256) :: aether_secondary_file_name = 'tiegcm_s.nc' +character(len=256) :: filter_inout_dir = '.' ! TODO; replace this GITM namelist var with Aether code. character(len=256) :: template_filename = 'no_file_specified.nc' integer :: debug = 0 logical :: estimate_f10_7 = .false. character(len=256) :: f10_7_file_name = 'f10_7.nc' -integer :: assimilation_period_seconds = 3600 real(r8) :: model_res = 5.0_r8 ! TODO: confirm that the units are days. ! Better to get the actual start day of Aether's calender. +character(len=32) :: calendar = 'Gregorian' integer :: aeth_ref_day = 2451545.0 ! cJULIAN2000 in Aether = day of date 2000/01/01. ! Day 0 in this calendar is (+/1 a day) -4710/11/24 0 UTC ! But what we care about is the ref time for the times in the files, which is 1964-12-31 23:30 @@ -168,7 +175,8 @@ module model_mod ! TODO: It seems that this was intended to be 1965-01-01-0, but mayber there's a time step issue. ! This should be in a namelist. -integer, dimension(:) :: aeth_ref_date(5) = (/1964,12,31,23,30/) ! y,mo,d,h,m (secs assumed 0) +integer, dimension(:) :: aeth_ref_date(5) = (/1965,1,1,0,0/) ! y,mo,d,h,m (secs assumed 0) +integer :: assimilation_period_seconds = 3600 ! Aether restart files have 81 fields in them, ! mostly the 6 components of velocities for each ion. @@ -176,11 +184,10 @@ module model_mod integer, parameter :: MAX_NUM_COLUMNS = 6 character(len=NF90_MAX_NAME) :: variables(MAX_NUM_VARIABLES * MAX_NUM_COLUMNS) = ' ' -namelist /model_nml/ aether_restart_file_name, & - aether_secondary_file_name, & +namelist /model_nml/ filter_inout_dir, & variables, debug, estimate_f10_7, & - f10_7_file_name, & - assimilation_period_seconds, model_res + f10_7_file_name, calendar, assimilation_period_seconds, & + model_res !------------------------------------------------------------------------------- ! define model parameters for creating the state NetCDF file @@ -216,7 +223,7 @@ module model_mod type(time_type) :: state_time ! module-storage declaration of current model time integer(i8) :: model_size ! the state vector length -integer :: nfields ! number of tiegcm variables in DART state +integer :: nfields, nfields_neutral, nfields_ion ! numbers of aether variables in DART state ! global domain id to be used by routines in state_structure_mod integer :: domain_id(3) ! restart, secondary, calculate integer, parameter :: RESTART_DOM = 1 @@ -253,7 +260,6 @@ module model_mod character(len=*), parameter :: LAT_VAR_NAME = 'lat' character(len=*), parameter :: ALT_VAR_NAME = 'alt' -integer, parameter :: MAX_NAME_LEN = 256 ! {nxPerBlock,nyPerBlock} are the number of non-halo {lons,lats} PER block ! the number of blocks comes from UAM.in ! nzPerBlock is the number of altitudes, which does not depend on block @@ -268,10 +274,11 @@ module model_mod ! since the latitudes/longitudes are at cell centers, ! while the edges are at the boundaries." -- Aaron Ridley -integer :: nBlocksLon=-1, nBlocksLat=-1 ! number of blocks along each dim +integer :: nBlocksLon=-1, nBlocksLat=-1, nBlocksAlt=-1 ! number of blocks along each dim real(r8) :: LatStart=MISSING_R8, LatEnd=MISSING_R8, LonStart=MISSING_R8 -! TODO; Changing defaults from -1 just so it will compile. -integer :: nSpeciesTotal=1, nSpecies=1, nIons=1, nSpeciesAll=1 +! TODO; These have been replaced by nfields_{ions,neutrals} +! Changing defaults from -1 just so it will compile. +! integer :: nSpeciesTotal=1, nSpecies=1, nIons=1, nSpeciesAll=1 contains !=============================================================================== @@ -281,8 +288,8 @@ subroutine static_init_model() integer :: iunit, io character(len=*), parameter :: routine = 'static_init_model' -if (module_initialized) return ! only need to do this once +if (module_initialized) return ! only need to do this once ! Print module information to log file and stdout. call register_module(source, revision, revdate) @@ -336,10 +343,12 @@ subroutine static_init_model() ! state structure call verify_variables() -call set_calendar_type('Gregorian') +call set_calendar_type(calendar) ! Convert the last year/day/hour/minute to a dart time. -state_time = read_model_time(aether_restart_file_name) +! TODO: replace read_model_time with read_state_time? +! Or at least don't hard-wire the file name. +state_time = read_model_time(filter_inout_dir) ! Assumes assimilation_period is a multiple of the dynamical timestep ! TIEGCM namelist has variable "STOP" @@ -385,18 +394,26 @@ subroutine static_init_blocks(restart_dirname) integer :: iunit, io, ivar !logical :: has_gitm_namelist +if (module_initialized) return ! only need to do this once + +! This prevents subroutines called from here from calling static_init_mod. +module_initialized = .true. + ! Read the namelist entry for model_mod from input.nml call read_model_namelist() ! error-check, convert namelist input to variable_table, and build the state structure call verify_variables() +! TODO already wrong +print*,'static_init_blocks: post-verify_variables; nfields_neutral = ', nfields_neutral ! 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) -! TODO: this is done only in aether_to_dart? +! TODO: Reading aether_to_dart_nml is done only in aether_to_dart? +! filter_inout_dir from here instead of redundant entry in model_mod_nml? ! ! Read the DART namelist for this model ! call find_namelist_in_file('input.nml', 'aether_to_dart_nml', iunit) ! read(iunit, nml = aether_to_dart_nml, iostat = io) @@ -408,12 +425,12 @@ subroutine static_init_blocks(restart_dirname) ! Get the GITM variables in a restricted scope setting. -! TODO: Replace with Aether code +! DONE(?): Replace nSpecies with Aether code ! nSpecies = get_nSpecies() ! nSpeciesTotal = get_nSpeciesTotal() ! nIons = get_nIons() ! nSpeciesAll = get_nSpeciesAll() -! TODO: These are calculated in get_grid_from_blocks +! DONE: These are calculated in get_grid_from_blocks ! nxPerBlock = get_nxPerBlock() ! nyPerBlock = get_nyPerBlock() ! nzPerBlock = get_nzPerBlock() @@ -422,7 +439,9 @@ subroutine static_init_blocks(restart_dirname) ! Set the time step ... causes gitm namelists to be read. ! Ensures model_advance_time is multiple of 'dynamics_timestep' -call set_calendar_type( 'Gregorian' ) ! comes from model_mod_nml +!TODO: Aether uses Julian time +! or calendar (days from the start of the calendar), depending on the context) +call set_calendar_type( calendar ) ! comes from model_mod_nml !--------------------------------------------------------------- ! 1) get grid dimensions @@ -430,33 +449,25 @@ subroutine static_init_blocks(restart_dirname) ! 3) read them from the block restart files, could be stretched ... call get_grid_info_from_blocks(restart_dirname, nlon, nlat, nalt, nBlocksLon, & - nBlocksLat, LatStart, LatEnd, LonStart) + nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) +print*,'static_init_blocks: post-get_grid_info_from_blocks; nfields_neutral = ', nfields_neutral if( debug > 0 ) then write(string1,*) 'grid dims are ',nlon,nlat,nalt call error_handler(E_MSG,routine,string1,source,revision,revdate) endif -! This is also done in gitm's static_init_model, which is not called by aether_to_dart, -! so it's not redundant. -allocate( lons( nlon )) -allocate( lats( nlat )) -allocate( alts( nalt )) - -! TODO; This defines n[xyz]PerBlock -call get_grid_from_blocks(restart_dirname, nBlocksLon, nBlocksLat, & +call get_grid_from_blocks(restart_dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & nxPerBlock, nyPerBlock, nzPerBlock, lons, lats, alts ) +print*,'static_init_blocks: post-get_grid_from_blocks; nfields_neutral = ', nfields_neutral +! Opens and closes the grid block file, but not the restart_netcdf file. +! So it's not relevant to the _define problem. ! this is going to have to loop over all the blocks, both to get ! the data values and to get the full grid spacings. state_time = get_state_time(restart_dirname) -if (do_output()) & - call print_time(state_time,'time in restart file '//trim(restart_dirname)//'/time.json') -if (do_output()) & - call print_date(state_time,'date in restart file '//trim(restart_dirname)//'/time.json') - ! TODO: Replace with aether variables check? ! call verify_block_variables( gitm_block_variables, nfields ) ! @@ -507,14 +518,14 @@ end subroutine read_model_namelist !> !> The file name comes from module storage ... namelist. -subroutine get_grid_info_from_blocks(gitm_restart_dirname, nlon, nlat, & - nalt, nBlocksLon, nBlocksLat, LatStart, LatEnd, LonStart) +subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, & + nalt, nBlocksLon, nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) -character(len=*), intent(in) :: gitm_restart_dirname +character(len=*), intent(in) :: restart_dirname integer, intent(out) :: nlon ! Number of Longitude centers integer, intent(out) :: nlat ! Number of Latitude centers integer, intent(out) :: nalt ! Number of Vertical grid centers -integer, intent(out) :: nBlocksLon, nBlocksLat +integer, intent(out) :: nBlocksLon, nBlocksLat, nBlocksAlt real(r8), intent(out) :: LatStart, LatEnd, LonStart ! TODO: get the grid info from a namelists (98 variables), instead of GITM's UAM.in. @@ -534,14 +545,15 @@ subroutine get_grid_info_from_blocks(gitm_restart_dirname, nlon, nlat, & nBlocksLon = 0 nBlocksLat = 0 +nBlocksAlt = 0 LatStart = 0.0_r8 LatEnd = 0.0_r8 LonStart = 0.0_r8 -write(fileloc,'(a,''/'',a)') trim(gitm_restart_dirname),trim(filename) +write(fileloc,'(a,''/'',a)') trim(restart_dirname),trim(filename) if (debug > 4) then - write(string1,*) 'Now opening GITM restart file: ',trim(fileloc) + write(string1,*) 'Now opening Aether UAM file: ',trim(fileloc) call error_handler(E_MSG,routine,string1,source,revision,revdate) end if @@ -563,6 +575,7 @@ subroutine get_grid_info_from_blocks(gitm_restart_dirname, nlon, nlat, & nBlocksLon = read_in_int( iunit,'NBlocksLon',trim(fileloc)) nBlocksLat = read_in_int( iunit,'NBlocksLat',trim(fileloc)) + nBlocksAlt = read_in_int( iunit,'NBlocksAlt',trim(fileloc)) LatStart = read_in_real(iunit,'LatStart', trim(fileloc)) LatEnd = read_in_real(iunit,'LatEnd', trim(fileloc)) LonStart = read_in_real(iunit,'LonStart', trim(fileloc)) @@ -572,12 +585,14 @@ subroutine get_grid_info_from_blocks(gitm_restart_dirname, nlon, nlat, & enddo UAMREAD if (debug > 4) then - write(string1,*) 'Successfully read GITM restart file:',trim(fileloc) + write(string1,*) 'Successfully read Aether UAM grid file:',trim(fileloc) call error_handler(E_MSG,routine,string1,source,revision,revdate) write(string1,*) ' nBlocksLon:',nBlocksLon call error_handler(E_MSG,routine,string1,source,revision,revdate) write(string1,*) ' nBlocksLat:',nBlocksLat call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nBlocksAlt:',nBlocksAlt + call error_handler(E_MSG,routine,string1,source,revision,revdate) write(string1,*) ' LatStart:',LatStart call error_handler(E_MSG,routine,string1,source,revision,revdate) write(string1,*) ' LatEnd:',LatEnd @@ -588,17 +603,6 @@ subroutine get_grid_info_from_blocks(gitm_restart_dirname, nlon, nlat, & call close_file(iunit) -nlon = nBlocksLon * nxPerBlock -nlat = nBlocksLat * nyPerBlock -nalt = nzPerBlock - -write(string1,*) 'nlon = ', nlon -call error_handler(E_MSG,routine,string1,source,revision,revdate) -write(string1,*) 'nlat = ', nlat -call error_handler(E_MSG,routine,string1,source,revision,revdate) -write(string1,*) 'nalt = ', nalt -call error_handler(E_MSG,routine,string1,source,revision,revdate) - end subroutine get_grid_info_from_blocks !================================================================== @@ -669,22 +673,24 @@ end function read_in_real ! open enough of the restart files to read in the lon, lat, alt arrays -subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, & +subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & nxPerBlock, nyPerBlock, nzPerBlock, & lons, lats, alts ) character(len=*), intent(in) :: dirname integer, intent(in) :: nBlocksLon ! Number of Longitude blocks integer, intent(in) :: nBlocksLat ! Number of Latitude blocks +integer, intent(in) :: nBlocksAlt ! Number of Altitude blocks integer, intent(out) :: nxPerBlock ! Number of non-halo Longitude centers per block integer, intent(out) :: nyPerBlock ! Number of non-halo Latitude centers per block integer, intent(out) :: nzPerBlock ! Number of Vertical grid centers -real(r8), dimension( : ), intent(inout) :: lons, lats, alts +real(r8), allocatable , dimension( : ), intent(inout) :: lons, lats, alts integer :: ios, nb, offset, ncid, nboff character(len=256) :: filename -real(r8), allocatable :: temp(:,:,:) +real(r4), allocatable :: temp(:,:,:) +integer :: starts(3),ends(3), xcount, ycount, zcount character(len=*), parameter :: routine = 'get_grid_from_blocks' @@ -699,7 +705,24 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, & ! to get the number of actual data values in each dimension of the block. nxPerBlock = nc_get_dimension_size(ncid, 'x', routine) - 2*nGhost nyPerBlock = nc_get_dimension_size(ncid, 'y', routine) - 2*nGhost -nzPerBlock = nc_get_dimension_size(ncid, 'z', routine) - 2*nGhost +nzPerBlock = nc_get_dimension_size(ncid, 'z', routine) + +nlon = nBlocksLon * nxPerBlock +nlat = nBlocksLat * nyPerBlock +nalt = nBlocksAlt * nzPerBlock + +write(string1,*) 'nlon = ', nlon +call error_handler(E_MSG,routine,string1,source,revision,revdate) +write(string1,*) 'nlat = ', nlat +call error_handler(E_MSG,routine,string1,source,revision,revdate) +write(string1,*) 'nalt = ', nalt +call error_handler(E_MSG,routine,string1,source,revision,revdate) + +! This is also done in gitm's static_init_model, which is not called by aether_to_dart, +! so it's not redundant. +allocate( lons( nlon )) +allocate( lats( nlat )) +allocate( alts( nalt )) if (debug > 4) then write(string1,*) 'Successfully read GITM grid file:',trim(filename) @@ -712,20 +735,50 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, & call error_handler(E_MSG,routine,string1,source,revision,revdate) endif -! a temp array large enough to hold any of the -! Lon,Lat or Alt array from a block plus ghost cells -allocate(temp(1-nGhost:nxPerBlock+nGhost, & - 1-nGhost:nyPerBlock+nGhost, & - 1:nzPerBlock)) +! A temp array large enough to hold any of the 3D +! Lon,Lat or Alt arrays from a block plus ghost cells. +! The restart files have C-indexing (fastest changing dim is the last). +allocate(temp( 1:nzPerBlock, & + 1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost)) +temp = -888888. + +print*,'shape of temp = ',shape(temp) + +starts(1) = 1-nGhost +starts(2) = 1-nGhost +starts(3) = 1 +ends(1) = nxPerBlock+nGhost +ends(2) = nyPerBlock+nGhost +ends(3) = nzPerBlock +xcount = nxPerBlock + 2*nGhost +ycount = nyPerBlock + 2*nGhost +zcount = nzPerBlock +print*,'starts = ',starts +print*,'ends = ',ends +print*,'counts = ',xcount,ycount,zcount ! go across the south-most block row picking up all longitudes do nb = 1, nBlocksLon -! TODO function open_block_file(dirname, filetype, memnum, blocknum, rw, filename) ncid = open_block_file(dirname, 'grid', -1, nb-1, 'read', filename) ! Read 3D array and extract the longitudes of the non-halo data of this block. - call nc_get_variable(ncid, 'Longitudes', temp, routine) +! This gets nc_get_double_3d, even though the fields are float. +!? Is there some environment setting that says float = double? +! ERROR This yields Start+count exceeds dimension bound +! call nc_get_variable(ncid, 'Longitude', temp, routine) +! ERROR: this yields Index exceeds dimension bound +! The restart files have C-indexing (fastest changing dim is the last), +! So invert the dimension bounds. + call nc_get_variable(ncid, 'Longitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + routine, & + nc_count=(/zcount,ycount,xcount/)) +! Shouldn't need to specify default values nc_start=(/1,1,1/), & + +! temp(1:zcount,1:ycount,1:xcount), & +! nc_start=(/starts(1),starts(2),starts(3)/), & ! TODO: nc_get_variable stops on error conditions, does not pass back ios. ! if ( ios /= 0 ) then ! print *,'size:',size(temp(1-nGhost:nxPerBlock+nGhost)) @@ -737,7 +790,7 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, & ! endif offset = (nxPerBlock * (nb - 1)) - lons(offset+1:offset+nxPerBlock) = temp(1:nxPerBlock,1,1) + lons(offset+1:offset+nxPerBlock) = temp(1,1,1:nxPerBlock) call nc_close_file(ncid) enddo @@ -745,12 +798,20 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, & ! go up west-most block row picking up all latitudes do nb = 1, nBlocksLat - ! TODO; Aether names start with 0, but the lat values can come from any lon=const column. + ! TODO; Aether block names start with 0, but the lat values can come from + ! any lon=const column. ! orig: nboff = ((nb - 1) * nBlocksLon) + 1 nboff = ((nb - 1) * nBlocksLon) ncid = open_block_file(dirname, 'grid', -1, nboff, 'read', filename) - call nc_get_variable(ncid, 'Latitudes', temp, routine) + call nc_get_variable(ncid, 'Latitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + routine, & + nc_count=(/zcount,ycount,xcount/)) +! nc_start=(/1,1,1/), & + +! call nc_get_variable(ncid, 'Latitude', temp, routine, nc_start=starts, & +! nc_count=(/xcount,ycount,zcount/)) ! if ( ios /= 0 ) then ! write(string1,*)'ERROR reading file ', trim(filename) ! write(string2,*)'latitude block ',nb,' of ',nBlocksLat @@ -771,9 +832,17 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, & ncid = open_block_file(dirname, 'grid', -1, 0, 'read', filename) -call nc_get_variable(ncid, 'Altitudes', temp, routine) +temp = -888888. +call nc_get_variable(ncid, 'Altitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + routine, & + nc_count=(/zcount,ycount,xcount/)) +! nc_start=(/1,1,1/), & +! call nc_get_variable(ncid, 'Altitude', temp, routine, nc_start=starts) -alts(1:nzPerBlock) = temp(1,1,1:nzPerBlock) +alts(1:nzPerBlock) = temp(1:nzPerBlock,1,1) +! print*,'temp = ',temp(:,1,1) +! print*,'alts = ',alts call nc_close_file(ncid) @@ -808,59 +877,39 @@ function get_state_time( dirname ) type(time_type) :: get_state_time character(len=*), intent(in) :: dirname -type(time_type) :: model_offset, base_time +type(time_type) :: base_time -integer :: iunit, i, ios -integer :: istep -real(r8) :: tsimulation +integer :: ncid, i, ios +integer :: tsimulation ! the time read from a restart file; seconds from aeth_ref_date. integer :: ndays,nsecs, base_ndays, base_nsecs character(len=256) :: filename -character(len=100) :: cLine character(len=*), parameter :: routine = 'get_state_time' tsimulation = MISSING_R8 -! TODO: should the source of the time be in a namelist? -! Tricky; time.json is a text file, restarts are NetCDF -write(filename,'(a,''/time.json'')') trim(dirname) - -iunit = open_file(trim(filename), action='read') - -FILEREAD : do i = 1, 10 - - read(iunit,'(a)',iostat=ios) cLine - - if (ios < 0) then - exit FILEREAD ! end of file - - else if (ios > 0) then - write(string1,*) 'cannot read ',trim(filename) - call error_handler(E_ERR,routine,string1,source,revision,revdate) - - else - select case( cLine(4:8) ) - case('istep') - read(iunit,*)istep - case('curre') - read(iunit,*)tsimulation - case default - end select - endif - -enddo FILEREAD - -call close_file(iunit) +ncid = open_block_file(dirname, 'grid', -1, 0, 'read', filename) +call nc_get_variable(ncid, 'time', tsimulation, routine) +call nc_close_file(ncid, routine, filename) +! Convert the Aether reference date (not calendar day = 0 date) +! to the days and seconds of the calendar set in model_mod_nml. base_time = set_date(aeth_ref_date(1), aeth_ref_date(2), aeth_ref_date(3), & aeth_ref_date(4), aeth_ref_date(5)) call get_time(base_time,base_nsecs,base_ndays) + +! Calculate the DART time of the file time. ndays = tsimulation/86400 nsecs = tsimulation - ndays*86400 ndays = base_ndays + ndays get_state_time = set_time(nsecs,ndays) +if (do_output()) & + call print_time(get_state_time,'get_state_time: time in restart file '//filename) +if (do_output()) & + call print_date(get_state_time,'get_state_time: date in restart file '//filename) + if (debug > 8) then write(string1,*)'tsimulation ',tsimulation call error_handler(E_MSG,routine,string1,source,revision,revdate) @@ -871,14 +920,10 @@ function get_state_time( dirname ) call print_date( base_time, 'get_state_time:model base date') call print_time( base_time, 'get_state_time:model base time') - call print_date(get_state_time, 'get_state_time:model date') - call print_time(get_state_time, 'get_state_time:model time') endif end function get_state_time - -!================================================================== !================================================================== !> open the requested block number restart file and return the ncid @@ -890,6 +935,7 @@ function open_block_file(dirname, filetype, memnum, blocknum, rw, filename) character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} ! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? ! This code can handle it; a longer filetype passed in, and no member +! ? output files? integer, intent(in) :: blocknum integer, intent(in) :: memnum character(len=*), intent(in) :: rw ! 'read' or 'readwrite' @@ -897,11 +943,12 @@ function open_block_file(dirname, filetype, memnum, blocknum, rw, filename) character(len=*), parameter :: routine = 'open_block_file' filename = trim(dirname)//'/'//trim(filetype) -if (memnum > 0) write(filename, '(A,A2,I4)') filename, '_m', memnum -if (blocknum > 0) write(filename, '(A,A2,I4)') filename, '_b', blocknum -filename = filename//'.nc' +if (memnum >= 0) write(filename, '(A,A2,I0.4)') trim(filename), '_m', memnum +if (blocknum >= 0) write(filename, '(A,A2,I0.4)') trim(filename), '_g', blocknum +filename = trim(filename)//'.nc' +print*,'filename, memnum, blocknum = ' ,trim(filename), memnum, blocknum -if ( rw == 'read' .and. .not. file_exist(filename) ) then +if ( rw == 'read' .and. .not. file_exist(trim(filename)) ) then write(string1,*) 'cannot open file ', trim(filename),' for reading.' call error_handler(E_ERR,'open_block_file',string1,source,revision,revdate) endif @@ -911,7 +958,7 @@ function open_block_file(dirname, filetype, memnum, blocknum, rw, filename) call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) end if -open_block_file = nc_open_file_readonly(filename, routine) +open_block_file = nc_open_file_readonly(trim(filename), routine) if (debug > 80) then write(string1,*) 'Returned file descriptor is ', open_block_file @@ -993,17 +1040,18 @@ end subroutine verify_block_variables !> is orthogonal and rectangular but can have irregular spacing along !> any or all of the three dimensions. -subroutine restart_files_to_netcdf(restart_dirname,netcdf_output_file) +subroutine restart_files_to_netcdf(restart_dirname, member, netcdf_output_file) character(len=*), intent(in) :: restart_dirname character(len=*), intent(in) :: netcdf_output_file +integer, intent(in) :: member integer :: ncid character(len=*), parameter :: routine = 'restart_files_to_netcdf' if (module_initialized ) then - write(string1,*)'The gitm mod was already initialized but ',trim(routine),& + write(string1,*)'The aether static_init_model was already initialized but ',trim(routine),& ' uses a separate initialization procedure' call error_handler(E_ERR,routine,string1,source,revision,revdate) end if @@ -1012,24 +1060,28 @@ subroutine restart_files_to_netcdf(restart_dirname,netcdf_output_file) ncid = nc_create_file(netcdf_output_file) -! TODO: This should probably be replaced by nc_write_model_atts(ncid). +! DONE: This should probably be replaced by nc_write_model_atts(ncid). ! That may require renaming some dimension variables. -call add_nc_definitions(ncid) +! call add_nc_definitions(ncid) +! Enters and exits define mode; +call nc_write_model_atts(ncid, 0) +print*,'Passed restart_files_to_netcdf:nc_write_model_atts' -! TODO: restore after domains question is answered -! call get_data(restart_dirname, ncid, define=.true.) +print*,'restart_files_to_netcdf: pre get_data; nfields_neutral = ',nfields_neutral -call nc_end_define_mode(ncid) +call get_data(restart_dirname, ncid, member, define=.true.) +! TODO: remove? Done in get_data now +! call nc_end_define_mode(ncid) -! TODO: This has not been activated because the functionality is in TIEGCM's nc_write_model_atts +! DONE: This has not been activated because the functionality is in TIEGCM's nc_write_model_atts ! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying ! the state vector field names and source. ! call add_nc_dimvars(ncid) -! TODO: restore after domains question is answered -! call get_data(restart_dirname, ncid, define=.false.) +call get_data(restart_dirname, ncid, member, define=.false.) -call print_time(state_time) +! DONE: this is done in static_init_blocks(?) +! call print_time(state_time) ! TODO: this needs to be updated to write to time.json, not a NetCDF file. ! call write_model_time(ncid, state_time) @@ -1073,12 +1125,14 @@ subroutine add_nc_definitions(ncid) call nc_define_dimension(ncid, LON_DIM_NAME, nlon) call nc_define_dimension(ncid, LAT_DIM_NAME, nlat) call nc_define_dimension(ncid, ALT_DIM_NAME, nalt) +! TODO: is WL in Aether? call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? !---------------------------------------------------------------------------- ! Create the (empty) Coordinate Variables and the Attributes !---------------------------------------------------------------------------- +! TODO: This defines more attributes than TIEGCM. Prefer? ! Grid Longitudes call nc_define_double_variable(ncid, LON_VAR_NAME, (/ LON_DIM_NAME /) ) call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'type', 'x1d') @@ -1113,123 +1167,124 @@ subroutine add_nc_definitions(ncid) end subroutine add_nc_definitions -! !================================================================= -! ! open all restart files and read in the requested data item -! -! subroutine get_data(dirname, ncid, define) -! -! character(len=*), intent(in) :: dirname -! integer, intent(in) :: ncid -! logical, intent(in) :: define -! -! integer :: ibLoop, jbLoop -! integer :: ib, jb, nb, iunit -! -! character(len=256) :: filename -! -! ! get the dirname, construct the filenames inside open_block_file -! -! if (define) then -! ! if define, run one block. -! ! the read_data_from_block call defines the variables in the whole domain netCDF file. -! ibLoop = 1 -! jbLoop = 1 -! else -! ! if not define, run all blocks. -! ! the read_data_from_block call adds the (ib,jb) block to a netCDF variable -! ! in order to make a file containing the data for all the blocks. -! ibLoop = nBlocksLon -! jbLoop = nBlocksLat -! end if -! -! ! TODO: loop over members somewhere -! ! including opening member files before getting data for them. -! do ft = 1,size(filetypes) Actually, loop over 2 domains? (somewhere) -! do jb = 1, jbLoop -! do ib = 1, ibLoop -! nb = (jb-1) * nBlocksLon + ib - 1 -! -! ! TODO; this is now an ncid. Update read_data_from_block to read from a NetCDF file. -! ncid = open_block_file(dirname, filetype(ft), mem, nb, 'read', filename) -! -! call nc_get_variable(ncid, 'Altitudes', temp, routine) -! -! call nc_close_file(ncid) -! -! ! iunit = open_block_file(dirname, nb, 'read', filename) -! ! -! ! call read_data_from_block(iunit, ib, jb, ncid, define) -! ! -! ! call close_file(iunit) -! enddo -! enddo -! enddo -! -! end subroutine get_data -! -! !================================================================== -! -! !> open all restart files and read in the requested data items -! !> -! !> This is a two-pass method: first run through to define the NC variables -! !> (define = .true.), then run again to write the data to the NC file -! !> (define = .false.) -! -! subroutine read_data_from_block(iunit, ib, jb, ncid, define) -! -! integer, intent(in) :: iunit -! integer, intent(in) :: ib, jb -! integer, intent(in) :: ncid -! logical, intent(in) :: define -! -! real(r8), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:), temp4d(:,:,:,:) -! real(r8), allocatable :: alt1d(:), density_ion_e(:,:,:) -! real(r8) :: temp0d !Alex: single parameter has "zero dimensions" -! integer :: i, j, inum, maxsize, ivals(NSpeciesTotal) -! integer :: block(2) = 0 -! -! logical :: no_idensity -! -! character(len=*), parameter :: routine = 'read_data_from_block' -! -! block(1) = ib -! block(2) = jb -! -! ! a temp array large enough to hold any of the -! ! Lon,Lat or Alt array from a block plus ghost cells -! allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) -! ! treat alt specially since we want to derive TEC here -! allocate( alt1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) -! -! ! temp array large enough to hold any 2D field -! allocate(temp2d(1-nGhost:nxPerBlock+nGhost, & -! 1-nGhost:nyPerBlock+nGhost)) -! -! ! temp array large enough to hold 1 species, temperature, etc -! allocate(temp3d(1-nGhost:nxPerBlock+nGhost, & -! 1-nGhost:nyPerBlock+nGhost, & -! 1-nGhost:nzPerBlock+nGhost)) -! -! ! save density_ion_e to compute TEC -! allocate(density_ion_e(1-nGhost:nxPerBlock+nGhost, & -! 1-nGhost:nyPerBlock+nGhost, & -! 1-nGhost:nzPerBlock+nGhost)) -! +!================================================================= +! open all restart files and read in the requested data item + +subroutine get_data(dirname, ncid_output, member, define) + +character(len=*), intent(in) :: dirname +integer, intent(in) :: ncid_output, member +logical, intent(in) :: define + +integer :: ibLoop, jbLoop +integer :: ib, jb, nb, iunit + +character(len=256) :: filename + +! get the dirname, construct the filenames inside open_block_file + +if (define) then + ! if define, run one block. + ! the read_data_from_block call defines the variables in the whole domain netCDF file. + ibLoop = 1 + jbLoop = 1 + call nc_begin_define_mode(ncid_output) +else + ! if not define, run all blocks. + ! the read_data_from_block call adds the (ib,jb) block to a netCDF variable + ! in order to make a file containing the data for all the blocks. + ibLoop = nBlocksLon + jbLoop = nBlocksLat +end if + +print*,'get_data: define = ',define +do jb = 1, jbLoop + do ib = 1, ibLoop + + call read_data_from_block(ncid_output, dirname, ib, jb, member, define) + + enddo +enddo + +if (define) call nc_end_define_mode(ncid_output) + +end subroutine get_data + +!================================================================== + +!> Open all restart files and read in the requested data items. +!> The unpack* calls will write the data to the filter_input.nc. +!> +!> This is a two-pass method: first run through to define the NC variables +!> in the filter_input.nc (define = .true.), +!> then run again to write the data to the NC file(define = .false.) + +subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) + +integer, intent(in) :: ncid_output +character(len=*), intent(in) :: dirname +integer, intent(in) :: ib, jb +integer, intent(in) :: member +logical, intent(in) :: define + +real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) +real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) +real(r4) :: temp0d !Alex: single parameter has "zero dimensions" +integer :: i, j, maxsize, ivar, nb, ncid_input +integer :: block(2) = 0 + +logical :: no_idensity + +character(len=*), parameter :: routine = 'read_data_from_block' +character(len=128) :: file_root +character(len=256) :: filename +character(len=NF90_MAX_NAME) :: varname + +block(1) = ib +block(2) = jb +! The block number, as counted in Aether. +! Lower left is 0, increase to the East, then 1 row farther north, West to East. +nb = (jb-1) * nBlocksLon + ib - 1 + +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) + +! treat alt specially since we want to derive TEC here +! TODO: do we? See density_ion_e too. +allocate( alt1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) + +! temp array large enough to hold any 2D field +allocate(temp2d(1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost)) + +! TODO: We need all altitudes, but there might be vertical blocks in the future. +! Keep the halo code here, but make nzcount adapt to whether there are blocks. +! And temp needs to have C-ordering, which is what the restart files have. +! temp array large enough to hold 1 species, temperature, etc +allocate(temp3d(1:nzPerBlock, & + 1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost)) + +! save density_ion_e to compute TEC +allocate(density_ion_e(1:nzPerBlock, & + 1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost)) + +! Aether gives a unique name to each (of 6) velocity components ! ! temp array large enough to hold velocity vect, etc ! maxsize = max(3, nSpecies) ! allocate(temp4d(1-nGhost:nxPerBlock+nGhost, & ! 1-nGhost:nyPerBlock+nGhost, & ! 1-nGhost:nzPerBlock+nGhost, maxsize)) -! -! ! get past lon and lat arrays and read in alt array -! read(iunit) temp1d(1-nGhost:nxPerBlock+nGhost) -! read(iunit) temp1d(1-nGhost:nyPerBlock+nGhost) -! ! save the alt1d for later TEC computation -! read(iunit) alt1d(1-nGhost:nzPerBlock+nGhost) -! -! ! Read the index from the first species + + +! TODO; Does Aether need a replacement for these Density fields? +! Don't need to fetch index because Aether has NetCDF restarts, +! so just loop over the field names to read. +! Read the index from the first species ! call get_index_from_gitm_varname('NDensityS', inum, ivals) -! + ! if (inum > 0) then ! ! if i equals ival, use the data from the state vect ! ! otherwise read/write what's in the input file @@ -1269,7 +1324,8 @@ end subroutine add_nc_definitions ! ! one or more items in the state vector need to replace the ! ! data in the output file. loop over the index list in order. ! j = 1 -! ! TODO: In Aether they're from an ions file. +! ! TODO: electron density is not in the restart files, but it's needed for TEC +! In Aether they're from an ions file. ! do i = 1, nIons ! if (debug > 80) then ! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & @@ -1302,77 +1358,91 @@ end subroutine add_nc_definitions ! read(iunit) temp3d ! enddo ! endif -! -! ! TODO: Neutrals? In Aether they're from a different file. -! read(iunit) temp3d -! call get_index_from_gitm_varname('Temperature', inum, ivals) -! -! if (inum > 0) then -! call unpack_data(temp3d, ivals(1), block, ncid, define) -! endif -! -! read(iunit) temp3d -! call get_index_from_gitm_varname('ITemperature', inum, ivals) -! if (inum > 0) then -! call unpack_data(temp3d, ivals(1), block, ncid, define) -! endif -! -! read(iunit) temp3d -! call get_index_from_gitm_varname('eTemperature', inum, ivals) -! if (inum > 0) then -! call unpack_data(temp3d, ivals(1), block, ncid, define) -! endif -! -! read(iunit) temp4d(:,:,:,1:3) -! call get_index_from_gitm_varname('Velocity', inum, ivals) -! if (inum > 0) then -! ! copy out any requested bits into state vector -! j = 1 -! do i = 1, 3 -! if (j <= inum) then -! if (i == gitmvar(ivals(j))%gitm_index) then -! temp3d = temp4d(:,:,:,i) -! call unpack_data(temp3d, ivals(j), block, ncid, define) -! j = j + 1 -! endif -! endif -! enddo -! endif -! -! read(iunit) temp4d(:,:,:,1:3) -! call get_index_from_gitm_varname('IVelocity', inum, ivals) -! if (inum > 0) then -! ! copy out any requested bits into state vector -! j = 1 -! do i = 1, 3 -! if (j <= inum) then -! if (i == gitmvar(ivals(j))%gitm_index) then -! ! read from input but write from state vector -! temp3d = temp4d(:,:,:,i) -! call unpack_data(temp3d, ivals(j), block, ncid, define) -! j = j + 1 -! endif -! endif -! enddo -! endif -! -! !print *, 'reading in temp4d for vvel' -! read(iunit) temp4d(:,:,:,1:nSpecies) -! call get_index_from_gitm_varname('VerticalVelocity', inum, ivals) -! if (inum > 0) then -! ! copy out any requested bits into state vector -! j = 1 -! do i = 1, nSpecies -! if (j <= inum) then -! if (i == gitmvar(ivals(j))%gitm_index) then -! temp3d = temp4d(:,:,:,i) -! call unpack_data(temp3d, ivals(j), block, ncid, define) -! j = j + 1 -! endif -! endif -! enddo -! endif -! + +! TODO: Neutrals? In Aether they're from a different file. +! Handle the 2 restart file types (ions and neutrals). +! Each field has a file type associated with it: variable_table(f_index,VT_ORIGININDX) +! TODO: for now require that all neutrals are listed in variable_table before the ions. + +file_root = variable_table(1,VT_ORIGININDX) +ncid_input = open_block_file(dirname, file_root, member, nb, 'read', filename) + +print*,'read_data_from_block: nfields_neutral = ',nfields_neutral +do ivar = 1, nfields_neutral + write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + + ! TODO: Given the subroutine name, perhaps these definition sections should be + ! one call higher up, with the same loop around it. + if (define) then + ! Define the variable in the filter_input.nc file (the output from this program). + ! The calling routine entered define mode. + + if (debug > 10) then + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',varname + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + + call nc_define_real_variable(ncid_output, varname, & + (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) + print*,routine,': defined ivar, varname = ', ivar, varname +! TODO: does the filter_input.nc file need all these attributes? TIEGCM doesn't add them. + ! They are not available from the restart files. + ! Add them to the ions section too. + ! call nc_add_attribute_to_variable(ncid, varname, 'long_name', gitmvar(ivar)%long_name) + ! call nc_add_attribute_to_variable(ncid, varname, 'units', gitmvar(ivar)%units) + ! !call nc_add_attribute_to_variable(ncid, varname, 'storder', gitmvar(ivar)%storder) + ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) + ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) + ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_index', gitmvar(ivar)%gitm_index) + + + else if (file_root == 'neutrals') then + ! Read 3D array and extract the non-halo data of this block. +! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. + call nc_get_variable(ncid_input, varname, temp3d, routine) + print*,'read_data_from_block: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),variable_table(ivar,VT_VARNAMEINDX) + print*,'read_data_from_block: define = ',define + call unpack_data(temp3d, ivar, block, ncid_output, define) + else + write(string1,*) 'Trying to read neutrals, but variable_table(',ivar,VT_ORIGININDX, & + ') /= "neutrals"' + call error_handler(E_ERR,routine,string1,source,revision,revdate) + endif + +enddo +call nc_close_file(ncid_input) + +file_root = variable_table(nfields_neutral+1,VT_ORIGININDX) +ncid_input = open_block_file(dirname, file_root, member, nb, 'read', filename) + +print*,'read_data_from_block: nfields_ion = ',nfields_ion +do ivar = nfields_neutral +1,nfields_neutral + nfields_ion + write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + + if (define) then + + if (debug > 10) then + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',varname + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + + call nc_define_real_variable(ncid_output, varname, & + (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) + print*,routine,': defined ivar, varname = ', ivar, varname + + else if (file_root == 'ions') then + call nc_get_variable(ncid_input, varname, temp3d, routine) + call unpack_data(temp3d, ivar, block, ncid_output, define) + else + write(string1,*) 'Trying to read ions, but variable_table(',ivar,VT_ORIGININDX, & + ') /= "ions"' + call error_handler(E_ERR,routine,string1,source,revision,revdate) + endif + +enddo +call nc_close_file(ncid_input) + +! TODO: Does Aether need TEC to be calculated? ! ! add the VTEC as an extended-state variable ! ! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program ! call get_index_from_gitm_varname('TEC', inum, ivals) @@ -1395,8 +1465,8 @@ end subroutine add_nc_definitions ! end if ! call unpack_data2d(temp2d, ivals(1), block, ncid, define) ! end if -! -! !alex begin + +! TODO: Does Aether need f10_7 to be calculated or processed? ! read(iunit) temp0d ! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') ! call get_index_from_gitm_varname('f107', inum, ivals) @@ -1409,66 +1479,16 @@ end subroutine add_nc_definitions ! if (inum > 0) then ! call unpack_data(temp3d, ivals(1), block, ncid, define) ! endif -! !alex end -! -! !print *, 'calling dealloc' -! deallocate(temp1d, temp2d, temp3d, temp4d) -! deallocate(alt1d, density_ion_e) -! -! end subroutine read_data_from_block -! -! !================================================================= -! ! Determine where any data from a given gitm_varname lies in the -! ! DART state vector. -! -! subroutine get_index_from_gitm_varname(gitm_varname, inum, ivals) -! -! character(len=*), intent(in) :: gitm_varname -! integer, intent(out) :: inum, ivals(:) -! -! integer :: gindex(nfields) -! integer :: i, limit -! -! inum = 0 -! limit = size(ivals) -! -! ! GITM handles variables in a way that might seem strange at first. -! ! It uses the same name but multiple indices. For example, the U, V, -! ! and W components of wind are index = 1, 2, 3 for the variable velocity. -! ! This is why the code below looks the way it does. -! FieldLoop : do i=1,nfields -! if (gitmvar(i)%gitm_varname /= gitm_varname) cycle FieldLoop -! inum = inum + 1 -! if (inum > limit) then -! write(string1,*) 'found too many matches, ivals needs to be larger than ', limit -! call error_handler(E_ERR,'get_index_from_gitm_varname',string1,source,revision,revdate) -! endif -! ! i is index into gitmvar array - the order of the fields in the sv -! ! gitm_index is index into the specific variable in the gitm restarts -! ivals(inum) = i -! gindex(inum) = gitmvar(i)%gitm_index -! enddo FieldLoop -! -! !if (inum > 0) then -! ! print *, 'before sort, inum: ', inum -! ! print *, 'before sort, gindex: ', gindex(1:inum) -! ! print *, 'before sort, ivals: ', ivals(1:inum) -! !endif -! -! ! return the vals sorted by gitm_index order if more than 1 -! if (inum > 1) call sortindexlist(gindex, ivals, inum) -! -! !if (inum > 0) then -! ! print *, 'after sort, inum: ', inum -! ! print *, 'after sort, gindex: ', gindex(1:inum) -! ! print *, 'after sort, ivals: ', ivals(1:inum) -! !endif -! -! end subroutine get_index_from_gitm_varname -! -! !================================================================== -! -! + +!print *, 'calling dealloc' +deallocate(temp1d, temp2d, temp3d) +deallocate(alt1d, density_ion_e) + +end subroutine read_data_from_block + +!================================================================== + +!> TODO: Activate f10_7 code? ! !> put the f107 estimate (a scalar, hence 0d) into the state vector. ! !> Written specifically ! !> for f107 since f107 is the same for all blocks. So what it does @@ -1556,59 +1576,54 @@ end subroutine add_nc_definitions ! end if ! ! end subroutine unpack_data2d -! -! !================================================================== -! -! ! put the requested data into a netcdf variable -! -! subroutine unpack_data(data3d, ivar, block, ncid, define) -! -! real(r8), intent(in) :: data3d(1-nGhost:nxPerBlock+nGhost, & -! 1-nGhost:nyPerBlock+nGhost, & -! 1-nGhost:nzPerBlock+nGhost) -! -! integer, intent(in) :: ivar ! variable index -! integer, intent(in) :: block(2) -! integer, intent(in) :: ncid -! logical, intent(in) :: define -! -! integer :: ib, jb -! integer :: starts(3) -! character(len=*), parameter :: routine = 'unpack_data' -! -! if (define) then -! -! if (debug > 10) then -! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! -! call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME, ALT_DIM_NAME /) ) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) -! !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) -! -! else -! -! ib = block(1) -! jb = block(2) -! -! ! to compute the start, consider (ib-1)*nxPerBlock+1 -! starts(1) = (ib-1)*nxPerBlock+1 -! starts(2) = (jb-1)*nyPerBlock+1 -! starts(3) = 1 -! -! call nc_put_variable(ncid, gitmvar(ivar)%varname, & -! data3d(1:nxPerBlock,1:nyPerBlock,1:nzPerBlock), & -! context=routine, nc_start=starts, & -! nc_count=(/nxPerBlock,nyPerBlock,nzPerBlock/)) -! end if -! -! end subroutine unpack_data -! + +!================================================================== + +! put the requested data into a netcdf variable + +subroutine unpack_data(data3d, ivar, block, ncid, define) + +real(r4), intent(in) :: data3d(1:nzPerBlock, & + 1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost) + +integer, intent(in) :: ivar ! variable index +integer, intent(in) :: block(2) +integer, intent(in) :: ncid +! TODO: remove 'define' code +logical, intent(in) :: define + +integer :: ib, jb +integer :: starts(3) +character(len=*), parameter :: routine = 'unpack_data' +character(len=NF90_MAX_NAME) :: varname + +print*,'unpack_data: data3d = ',data3d(1,1,1),data3d(15,15,15) +print*,'unpack_data: define = ',define + +write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + +if (define) then + +else + ib = block(1) + jb = block(2) + + ! to compute the start, consider (ib-1)*nxPerBlock+1 + starts(1) = 1 + starts(2) = (jb-1)*nyPerBlock+1 + starts(3) = (ib-1)*nxPerBlock+1 + + call nc_put_variable(ncid, varname, & + data3d(1:nzPerBlock,1:nyPerBlock,1:nxPerBlock), & + context=routine, nc_start=starts, & + nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) + print*,'unpack_data: filled varname = ', varname + +end if + +end subroutine unpack_data + !================================================================= !> sort list x into order based on values in list. @@ -1902,7 +1917,7 @@ end subroutine end_model !================================================================== ! Writes the model-specific attributes to a netCDF file. -subroutine nc_write_model_atts( ncid, dom_id ) +subroutine nc_write_model_atts( ncid, dom_id) integer, intent(in) :: ncid ! netCDF file identifier integer, intent(in) :: dom_id @@ -1913,18 +1928,20 @@ subroutine nc_write_model_atts( ncid, dom_id ) if ( .not. module_initialized ) call static_init_model ! Write Global Attributes -call nc_begin_define_mode(ncid, routine) +! TODO: trying to run showed that this file is already in define mode. +! I haven't tracked down whether it should have been taken out. +! call nc_begin_define_mode(ncid, routine) call nc_add_global_creation_time(ncid, routine) call nc_add_global_attribute(ncid, "model_source", source, routine) -call nc_add_global_attribute(ncid, "model", "TIEGCM", routine) +call nc_add_global_attribute(ncid, "model", "Aether", routine) ! define grid dimensions call nc_define_dimension(ncid, LON_DIM_NAME, nlon, routine) call nc_define_dimension(ncid, LAT_DIM_NAME, nlat, routine) -call nc_define_dimension(ncid, ALT_DIM_NAME, all_nalt, routine) +call nc_define_dimension(ncid, ALT_DIM_NAME, nalt, routine) call nc_define_dimension(ncid, 'ilev', nilev, routine) ! define grid variables @@ -1940,24 +1957,24 @@ subroutine nc_write_model_atts( ncid, dom_id ) ! alts call nc_define_real_variable( ncid, ALT_DIM_NAME, (/ ALT_DIM_NAME /), routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'long_name', 'midpoint levels', routine) -! TODO: vert coord is altitude, not ... -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'short name', 'ln(p0/p)', routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'long_name', 'midpoint altitudes', routine) +! DONE: vert coord is altitude, not ... +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'short name', 'altitude', routine) call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'positive', 'up', routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula_terms', 'p0: p0 lev: lev', routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-lev(k))', routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'standard_name', 'unknown', routine) +! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula_terms', 'p0: p0 lev: lev', routine) +! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-lev(k))', routine) ! ilevs -call nc_define_real_variable( ncid, 'ilev', (/ 'ilev' /), routine) -call nc_add_attribute_to_variable(ncid, 'ilev', 'long_name', 'interface levels', routine) -call nc_add_attribute_to_variable(ncid, 'ilev', 'short name', 'ln(p0/p)', routine) -call nc_add_attribute_to_variable(ncid, 'ilev', 'positive', 'up', routine) -call nc_add_attribute_to_variable(ncid, 'ilev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) -call nc_add_attribute_to_variable(ncid, 'ilev', 'formula_terms', 'p0: p0 lev: ilev', routine) -! TODO: Is there an interface alt? -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-ilev(k))', routine) +! call nc_define_real_variable( ncid, 'ilev', (/ 'ilev' /), routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'long_name', 'interface levels', routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'short name', 'ln(p0/p)', routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'positive', 'up', routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'formula_terms', 'p0: p0 lev: ilev', routine) +! ! TODO: Is there an interface alt? +! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-ilev(k))', routine) call nc_end_define_mode(ncid, routine) @@ -1995,16 +2012,20 @@ subroutine nc_write_model_atts( ncid, dom_id ) ! ! end subroutine add_nc_dimvars ! - - - - - - - - - - - + + ! Fill in the coordinate variables -! longitude - TIEGCM uses values +/- 180, DART uses values [0,360] +! longitude - Aether uses values +/- pi, but lons has been converted already. +! DART uses values [0,360] allocate(temp_lons(nlon)) temp_lons = lons -where (temp_lons >= 180.0_r8) temp_lons = temp_lons - 360.0_r8 +where (temp_lons < 0.0_r8) temp_lons = temp_lons + 360.0_r8 +! where (temp_lons >= 180.0_r8) temp_lons = temp_lons - 360.0_r8 call nc_put_variable(ncid, LON_VAR_NAME, temp_lons, routine) call nc_put_variable(ncid, LAT_VAR_NAME, lats, routine) -call nc_put_variable(ncid, ALT_VAR_NAME, all_alts, routine) -call nc_put_variable(ncid, 'ilev', ilevs, routine) +call nc_put_variable(ncid, ALT_VAR_NAME, alts, routine) +! call nc_put_variable(ncid, 'ilev', ilevs, routine) deallocate(temp_lons) ! flush any pending i/o to disk @@ -2179,7 +2200,7 @@ end subroutine convert_vertical_state !------------------------------------------------------------------------------- ! Called from static_init_model. -! TODO: probably needs to be updated as get_state_time, which is called by static_init_blocks. +! TODO: probably needs to be updated like get_state_time, which is called by static_init_blocks. function read_model_time(filename) character(len=*), intent(in) :: filename @@ -2195,7 +2216,7 @@ function read_model_time(filename) character(len=*), parameter :: routine = 'read_model_time' -ncid = nc_open_file_readonly(filename, routine) +ncid = nc_open_file_readonly(trim(filename), routine) time_dimlen = nc_get_dimension_size(ncid, 'time', routine) dimlen = nc_get_dimension_size(ncid, 'mtimedim', routine) @@ -2236,6 +2257,7 @@ end function read_model_time ! Routines below here are private to the module !=============================================================================== +! TODO; Not called anymore. Has all functionality been replaced? subroutine read_TIEGCM_definition(file_name) ! Read TIEGCM grid definition from a tiegcm restart file ! fills metadata storage variables: @@ -2327,8 +2349,9 @@ end subroutine read_TIEGCM_definition subroutine verify_variables() -integer :: nfields_restart ! number of variables from restart file -integer :: nfields_secondary ! number of variables from secondary file +! TODO: is this making them local variables and implicitly reinitializing them to 0? +! integer :: nfields_neutral ! number of variables from restart file +! integer :: nfields_ion ! number of variables from secondary file integer :: nfields_constructed ! number of constructed state variables integer :: i, nrows, ncols @@ -2350,13 +2373,13 @@ subroutine verify_variables() ! Column 2 is the corresponding DART kind. ! Column 3 is the minimum value ("NA" if there is none) Not Applicable ! Column 4 is the maximum value ("NA" if there is none) Not Applicable -! Column 5 is the file of origin tiegcm 'restart' or 'secondary' +! Column 5 is the file of origin aether restart 'neutrals' or 'ions' ! Column 6 is whether or not the variable should be updated in the restart file. nfields = 0 -! TODO: TIEGCM uses 3 domains. Aeither may need only 1: -nfields_restart = 0 -nfields_secondary = 0 +! TODO: TIEGCM uses 3 domains. Aether may need only 1: +nfields_neutral = 0 +nfields_ion = 0 nfields_constructed = 0 ROWLOOP : do i = 1, nrows @@ -2368,7 +2391,9 @@ subroutine verify_variables() filename = trim(variables(ncols*i - 1)) state_or_aux = trim(variables(ncols*i )) - call to_upper(filename) +! TODO: does filename need to be upper case for some reason? +! Aether doesn't want it to be. +! call to_upper(filename) call to_upper(state_or_aux) ! update or not variable_table(i,VT_VARNAMEINDX) = trim(varname) @@ -2398,9 +2423,16 @@ subroutine verify_variables() ! endif nfields=nfields+1 - if (variable_table(i,VT_ORIGININDX) == 'RESTART') nfields_restart = nfields_restart+1 - if (variable_table(i,VT_ORIGININDX) == 'SECONDARY') nfields_secondary = nfields_secondary+1 - if (variable_table(i,VT_ORIGININDX) == 'CALCULATE') nfields_constructed = nfields_constructed + 1 + if (trim(variable_table(i,VT_ORIGININDX)) == 'neutrals') then + nfields_neutral = nfields_neutral+1 + else if (trim(variable_table(i,VT_ORIGININDX)) == 'ions') then + nfields_ion = nfields_ion+1 + else if (trim(variable_table(i,VT_ORIGININDX)) == 'CALCULATE') then + nfields_constructed = nfields_constructed + 1 + else + print*,'variable_table(',i, VT_ORIGININDX,') = ', trim(variable_table(i,VT_ORIGININDX)) + endif + print*,'verify_variables: nfields = ',nfields, nfields_neutral, nfields_ion enddo ROWLOOP @@ -2424,7 +2456,8 @@ subroutine verify_variables() enddo endif -if (nfields_secondary == 0) call error_handler(E_ERR, 'ZG is required in &model_nml::variables', source) +! TODO: Does Aether need ZG (gravity at the top altitude?) +! if (nfields_ion == 0) call error_handler(E_ERR, 'ZG is required in &model_nml::variables', source) ! TODO: TIEGCM uses 3 domains, so this section may need to be modified to look more like gitm's: ! ! gitm only has a single domain (only a single grid, no nests or multiple grids) @@ -2437,23 +2470,24 @@ subroutine verify_variables() ! if (debug > 1) call state_structure_info(domain_id) ! ! end subroutine set_gitm_variable_info +! +! call load_up_state_structure_from_file(aether_restart_file_name, nfields_neutral, 'RESTART', RESTART_DOM) +! call load_up_state_structure_from_file(aether_secondary_file_name, nfields_ion, 'SECONDARY', SECONDARY_DOM) -call load_up_state_structure_from_file(aether_restart_file_name, nfields_restart, 'RESTART', RESTART_DOM) -call load_up_state_structure_from_file(aether_secondary_file_name, nfields_secondary, 'SECONDARY', SECONDARY_DOM) - -if (estimate_f10_7) then - if (nfields_constructed == 0) then - call error_handler(E_ERR, 'expecting f10.7 in &model_nml::variables', source) - endif - call load_up_state_structure_from_file(f10_7_file_name, nfields_constructed, 'CALCULATE', CONSTRUCT_DOM) - model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) & - + get_domain_size(CONSTRUCT_DOM) -else - model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) -endif - -! set ivar. ZG is in the secondary domain -ivarZG = get_varid_from_varname(domain_id(SECONDARY_DOM), 'ZG') +! TODO: Aether may need something like this. +! if (estimate_f10_7) then +! if (nfields_constructed == 0) then +! call error_handler(E_ERR, 'expecting f10.7 in &model_nml::variables', source) +! endif +! call load_up_state_structure_from_file(f10_7_file_name, nfields_constructed, 'CALCULATE', CONSTRUCT_DOM) +! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) & +! + get_domain_size(CONSTRUCT_DOM) +! else +! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) +! endif +! +! ! set ivar. ZG is in the secondary domain +! ivarZG = get_varid_from_varname(domain_id(SECONDARY_DOM), 'ZG') end subroutine verify_variables diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index 9e59c55307..df67994069 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -1,29 +1,44 @@ -TIEGCM: +! TIEGCM: (Any variables from GITM?) &model_nml - debug = 1 - tiegcm_restart_file_name = 'tiegcm_restart_p.nc' - tiegcm_secondary_file_name = 'tiegcm_s.nc' + debug = 100 + filter_inout_dir = 'testdata1/restartOut.Sphere.1member' estimate_f10_7 = .false. f10_7_file_name = 'f10_7.nc' + variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', + 'O+', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + calendar = 'Gregorian' assimilation_period_seconds = 3600 - variables = 'NE', 'QTY_ELECTRON_DENSITY', '1000.0', 'NA', 'restart', 'UPDATE' - 'OP', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', + / +! >>> Don't code these until we get new CF-compliant field names from Aaron. <<< +! Other neutrals from restart files, which Aaron identified as important: + Zonal\ Wind + Meridional\ Wind +! Other ions from restart files, which Aaron identified as important: + O2+ + O+2D + O+2P + N2+ +! Other neutrals + Vertical\ Wind + 'TI', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'restart', 'UPDATE', 'TE', 'QTY_TEMPERATURE_ELECTRON', 'NA', 'NA', 'restart', 'UPDATE', 'OP_NM', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', 'O1', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.99999', 'restart', 'NO_COPY_BACK', 'O2', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.99999', 'restart', 'UPDATE', 'TN', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'UPDATE', - 'ZG', 'QTY_GEOMETRIC_HEIGHT', 'NA', 'NA', 'secondary', 'NO_COPY_BACK', - / +Delete from namelist + assimilation_period_seconds = 3600 + tiegcm_restart_file_name = 'tiegcm_restart_p.nc' + tiegcm_secondary_file_name = 'tiegcm_s.nc' -GITM: +! GITM: # The list of variables to put into the state vector is here: # The definitions for the DART kinds are in DART/obs_def/obs_def*f90 # The order doesn't matter to DART. It may to you. -&model_nml +! &model_nml gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', assimilation_period_days = 0, assimilation_period_seconds = 1800, diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index f81f02eee2..de635f0378 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -120,7 +120,8 @@ # 2: DART KIND # 3: minimum value - as a character string - if none, use 'NA' # 4: maximum value - as a character string - if none, use 'NA' -# 5: which aether netcdf file contains the variable - restart or secondary +# 5: which aether netcdf file contains the variable - neutrals or ions +# All neutrals must be listed before the ions. # 6: does the updated variable # 'UPDATE' => updated variable written to file # 'NO_COPY_BACK' => variable not written to file @@ -162,54 +163,29 @@ # / &model_nml - gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', - assimilation_period_days = 0, - assimilation_period_seconds = 1800, - model_perturbation_amplitude = 0.2, - calendar = 'Gregorian', - debug = 0, - gitm_state_variables = - 'Temperature', 'QTY_TEMPERATURE', - 'eTemperature', 'QTY_TEMPERATURE_ELECTRON', - 'ITemperature', 'QTY_TEMPERATURE_ION', - 'iO_3P_NDensityS', 'QTY_DENSITY_NEUTRAL_O3P', - 'iO2_NDensityS', 'QTY_DENSITY_NEUTRAL_O2', - 'iN2_NDensityS', 'QTY_DENSITY_NEUTRAL_N2', - 'iN_4S_NDensityS', 'QTY_DENSITY_NEUTRAL_N4S', - 'iNO_NDensityS', 'QTY_DENSITY_NEUTRAL_NO', - 'iN_2D_NDensityS', 'QTY_DENSITY_NEUTRAL_N2D', - 'iN_2P_NDensityS', 'QTY_DENSITY_NEUTRAL_N2P', - 'iH_NDensityS', 'QTY_DENSITY_NEUTRAL_H', - 'iHe_NDensityS', 'QTY_DENSITY_NEUTRAL_HE', - 'iCO2_NDensityS', 'QTY_DENSITY_NEUTRAL_CO2', - 'iO_1D_NDensityS', 'QTY_DENSITY_NEUTRAL_O1D', - 'iO_4SP_IDensityS', 'QTY_DENSITY_ION_O4SP', - 'iO2P_IDensityS', 'QTY_DENSITY_ION_O2P', - 'iN2P_IDensityS', 'QTY_DENSITY_ION_N2P', - 'iNP_IDensityS', 'QTY_DENSITY_ION_NP', - 'iNOP_IDensityS', 'QTY_DENSITY_ION_NOP', - 'iO_2DP_IDensityS', 'QTY_DENSITY_ION_O2DP', - 'iO_2PP_IDensityS', 'QTY_DENSITY_ION_O2PP', - 'iHP_IDensityS', 'QTY_DENSITY_ION_HP', - 'iHeP_IDensityS', 'QTY_DENSITY_ION_HEP', - 'ie_IDensityS', 'QTY_DENSITY_ION_E', - 'U_Velocity_component', 'QTY_VELOCITY_U', - 'V_Velocity_component', 'QTY_VELOCITY_V', - 'W_Velocity_component', 'QTY_VELOCITY_W', - 'U_IVelocity_component', 'QTY_VELOCITY_U_ION', - 'V_IVelocity_component', 'QTY_VELOCITY_V_ION', - 'W_IVelocity_component', 'QTY_VELOCITY_W_ION', - 'iO_3P_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_O3P', - 'iO2_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_O2', - 'iN2_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_N2', - 'iN_4S_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_N4S', - 'iNO_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_NO', - 'f107', 'QTY_1D_PARAMETER', - 'Rho', 'QTY_DENSITY', - / + debug = 100 + filter_inout_dir = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' + estimate_f10_7 = .false. + f10_7_file_name = 'f10_7.nc' + variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', + 'O+', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + calendar = 'Gregorian' + assimilation_period_seconds = 3600 + / +! >>> Don't code these until we get new CF-compliant field names from Aaron. <<< +! Other neutrals from restart files, which Aaron identified as important: + Zonal\ Wind + Meridional\ Wind +! Other ions from restart files, which Aaron identified as important: + O2+ + O+2D + O+2P + N2+ +! Other neutrals + Vertical\ Wind &aether_to_dart_nml - aether_restart_input_dirname = 'none' + aether_restart_input_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' aether_to_dart_output_file = 'filter_input.nc' / From 2dbe54b1eae177aa0b2e0a55a86c3ef76ead08de Mon Sep 17 00:00:00 2001 From: kdraeder Date: Wed, 1 Nov 2023 08:35:05 -0600 Subject: [PATCH 048/124] aether_to_dart: compiled, ran, checked output Removed ilev code; no fields defined there or needed for interpolation. domains code ZG code Straightened out reading times: Moved definition of reference day and time to static_init_blocks and static_init_model Removed existing read_model_time and changed get_state_time to read_model_time. Extracted the aether file name creation from open_block_file into function block_file_name. Then block_file_name can be called before the read_ routines, which want a filename, not a directory. Modified: model_mod.f90 Extracted the restart file name creation from open_block_file into function block_file_name. Made aether_ref* global variables. Removed more domain code. Renamed verify_variables to make_variable_table, because it doesn't verify. The output filter_input.nc Temperature matches the 4 neutrals restart files and O+ matches the 4 ions restarts. (mac:~/DAI/Aether/Reordered_dims/compare*png) Todo: Can static_init_{model,blocks} be combined? Or both call a common subroutine? Remove filter_io_filename from get_grid_from_netcdf arg list? (it's global) Convert some prints to error_handler. Delete the rest. Write dart_to_aether Merge the *_to_* code into Ben's model_mod. --- models/aether_lon-lat/model_mod.f90 | 2181 ++++++++++++--------------- models/aether_lon-lat/model_mod.nml | 2 +- 2 files changed, 931 insertions(+), 1252 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 192374311d..0838a14f14 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -9,18 +9,12 @@ ! seems to be the same in GITM and Aether, ! Those subroutines need to be adapted to the infrastructure in this model_mod ! and to the Aether restart files' format and contents. +! Later they will be exported to a model_mod Ben is developing from scratch. ! The model_mod.nml initially has the namelists from both tiegcm and gitm. ! Parts of both may be useful and will be merged into a new aether_lon-lat nml. -! >>> See TODOs throughout, before compiling -! TODOs from models/tiegcm: -! - Nick Dietrich fix_mmr. When do to this? -! - model_time -! - get_state_meta_data 2D variables -! - test vtec - module model_mod !------------------------------------------------------------------------------- @@ -41,6 +35,7 @@ module model_mod use location_mod, only : location_type, & get_close_obs, & +! TODO: need this from Ben's model_mod loc_get_close_state => get_close_state, & set_location, get_location, & get_dist, query_location, & @@ -106,11 +101,6 @@ module model_mod use dart_time_io_mod, only : write_model_time -! use dart_aether_mod, only : get_nxPerBlock, get_nyPerBlock, get_nzPerBlock -! TODO: How does aether provide the species?, & -! decode_gitm_indices -! get_nSpecies, get_nSpeciesTotal, get_nIons, get_nSpeciesAll, & - use netcdf implicit none @@ -136,11 +126,13 @@ module model_mod public :: adv_1step, & init_conditions, & init_time, & - pert_model_copies, & - get_state_time + pert_model_copies -! Interfaces needed by aether_to_dart and dart_to_aether -public :: restart_files_to_netcdf +! Interfaces needed by other programs, e.g. aether_to_dart and dart_to_aether +! block_file_name creates an Aether restart file name, +! which is useful for read_model_time calls, and others. +public :: restart_files_to_netcdf, & + block_file_name ! version controlled file description for error handling, do not edit character(len=256), parameter :: source = 'aether_lon-lat/model_mod.f90' @@ -157,9 +149,12 @@ module model_mod ! num_fields {nfields_neutral, nfields_ion, 2, ?, ...) ! character(len=8), dimension(2) :: file_root = /('neutrals','ions'/) -character(len=256) :: filter_inout_dir = '.' -! TODO; replace this GITM namelist var with Aether code. -character(len=256) :: template_filename = 'no_file_specified.nc' +! TODO; does it actually need filter_io_dir, or will the scripts make these programs +! run where the restart files are? +character(len=256) :: filter_io_dir = '.' +! TODO; remove GITM namelist vars +! TODO: if filter_io_filename is in global storage it doesn't need to be in (some?) arg lists. +character(len=256) :: filter_io_filename = 'no_file_specified.nc' integer :: debug = 0 logical :: estimate_f10_7 = .false. character(len=256) :: f10_7_file_name = 'f10_7.nc' @@ -167,24 +162,26 @@ module model_mod ! TODO: confirm that the units are days. ! Better to get the actual start day of Aether's calender. -character(len=32) :: calendar = 'Gregorian' integer :: aeth_ref_day = 2451545.0 ! cJULIAN2000 in Aether = day of date 2000/01/01. +character(len=32) :: calendar = 'Gregorian' ! Day 0 in this calendar is (+/1 a day) -4710/11/24 0 UTC ! But what we care about is the ref time for the times in the files, which is 1964-12-31 23:30 -! (from echo 2011032000 -1458347400s | ./advance_time). +! (from echo 2011032000 -1458345600s | ./advance_time). -! TODO: It seems that this was intended to be 1965-01-01-0, but mayber there's a time step issue. -! This should be in a namelist. integer, dimension(:) :: aeth_ref_date(5) = (/1965,1,1,0,0/) ! y,mo,d,h,m (secs assumed 0) +type(time_type) :: aeth_ref_time +integer :: aeth_ref_ndays, aeth_ref_nsecs + integer :: assimilation_period_seconds = 3600 -! Aether restart files have 81 fields in them, -! mostly the 6 components of velocities for each ion. +! TODO: Aether restart files have 81 fields in them, +! mostly the 6 components of velocities for each ion. +! Aaron will provide files with a few more fields; e-, f10_7, ...? integer, parameter :: MAX_NUM_VARIABLES = 100 integer, parameter :: MAX_NUM_COLUMNS = 6 character(len=NF90_MAX_NAME) :: variables(MAX_NUM_VARIABLES * MAX_NUM_COLUMNS) = ' ' -namelist /model_nml/ filter_inout_dir, & +namelist /model_nml/ filter_io_dir, & variables, debug, estimate_f10_7, & f10_7_file_name, calendar, assimilation_period_seconds, & model_res @@ -193,15 +190,12 @@ module model_mod ! define model parameters for creating the state NetCDF file ! and handling interpolation, get_close, ... -! nilev is number of interface levels ! nalt is number of midpoint levels -! TODO: Are Xilev useful in Aether? -! Replace plevs with hlevs? Maybe not; pressure levels may be needed for interp. -integer :: nilev, nalt, nlon, nlat -real(r8),dimension(:), allocatable :: lons, lats, alts, ilevs, plevs, pilevs -! levels + top level boundary condition for nalt. -integer :: all_nalt -real(r8),dimension(:), allocatable :: all_alts +! TODO: Replace plevs with hlevs? Maybe not; pressure levels may be needed for interp. +! nilev -> an aether dimension size, that's not interface levels. +! Is not used by aether_to_dart or dart_to_aether (?). +integer :: nalt, nlon, nlat, nilev +real(r8),dimension(:), allocatable :: lons, lats, alts, plevs, ilevs ! HK are plevs, pilevs per ensemble member? real(r8) :: TIEGCM_reference_pressure integer :: time_step_seconds @@ -224,13 +218,8 @@ module model_mod integer(i8) :: model_size ! the state vector length integer :: nfields, nfields_neutral, nfields_ion ! numbers of aether variables in DART state -! global domain id to be used by routines in state_structure_mod -integer :: domain_id(3) ! restart, secondary, calculate -integer, parameter :: RESTART_DOM = 1 -integer, parameter :: SECONDARY_DOM = 2 -integer, parameter :: CONSTRUCT_DOM = 3 -! lon and lat grid specs. 2.5 degree or 5 degree grid +! lon and lat grid specs. real(r8) :: bot_lon = MISSING_R8 real(r8) :: top_lon = MISSING_R8 real(r8) :: delta_lon = MISSING_R8 @@ -242,9 +231,6 @@ module model_mod ! Obs locations are expected to be given in height [m] or level, ! and so vertical localization coordinate is *always* height. -! Note that gravity adjusted geopotential height (ZG) is read in -! "tiegcm_s.nc". ZG is 'cm', dart is mks -integer :: ivarZG character(len=512) :: string1, string2, string3 logical, save :: module_initialized = .false. @@ -264,6 +250,8 @@ module model_mod ! the number of blocks comes from UAM.in ! nzPerBlock is the number of altitudes, which does not depend on block ! nGhost is the halo region width in the block(subdomain) files. +! TODO: n[xyz]PerBlock should probably come from a namelist (aether_to_dart.nml; +! can that be used for dart_to_aether?) integer :: nxPerBlock, nyPerBlock, nzPerBlock integer, parameter :: nGhost = 2 ! number of ghost cells on all edges @@ -274,11 +262,9 @@ module model_mod ! since the latitudes/longitudes are at cell centers, ! while the edges are at the boundaries." -- Aaron Ridley -integer :: nBlocksLon=-1, nBlocksLat=-1, nBlocksAlt=-1 ! number of blocks along each dim +! number of blocks along each dim +integer :: nBlocksLon=MISSING_I, nBlocksLat=MISSING_I, nBlocksAlt=MISSING_I real(r8) :: LatStart=MISSING_R8, LatEnd=MISSING_R8, LonStart=MISSING_R8 -! TODO; These have been replaced by nfields_{ions,neutrals} -! Changing defaults from -1 just so it will compile. -! integer :: nSpeciesTotal=1, nSpecies=1, nIons=1, nSpeciesAll=1 contains !=============================================================================== @@ -288,6 +274,7 @@ subroutine static_init_model() integer :: iunit, io character(len=*), parameter :: routine = 'static_init_model' +character(len=128) :: aether_filename if (module_initialized) return ! only need to do this once ! Print module information to log file and stdout. @@ -306,7 +293,7 @@ subroutine static_init_model() !--------------------------------------------------------------- ! get whole grid dimensions and values -write(string1,'(3A)') "Now reading template file ",trim(template_filename),& +write(string1,'(3A)') "Now reading filter_io file ",trim(filter_io_filename),& " for grid information" call error_handler(E_MSG,routine,string1,source,revision,revdate) @@ -316,9 +303,7 @@ subroutine static_init_model() !--------------------------------------------------------------- ! get grid dimensions and values -! TODO: reactivate after aether_to_dart tests -! lons, lats, alts and n??? are in global storage; remove from subr calls. -! call get_grid_from_netcdf(template_filename, lons, lats, alts) +call get_grid_from_netcdf(filter_io_filename, lons, lats, alts) !--------------------------------------------------------------- @@ -341,18 +326,15 @@ subroutine static_init_model() ! error-check, convert namelist input to variable_table, and build the ! state structure -call verify_variables() +call make_variable_table() call set_calendar_type(calendar) -! Convert the last year/day/hour/minute to a dart time. -! TODO: replace read_model_time with read_state_time? -! Or at least don't hard-wire the file name. -state_time = read_model_time(filter_inout_dir) +! Read and convert the time (seconds from the aether_ref_date) to a dart time. +aether_filename = block_file_name(variable_table(1,VT_ORIGININDX), 0, 0) +state_time = read_model_time(trim(aether_filename)) -! Assumes assimilation_period is a multiple of the dynamical timestep -! TIEGCM namelist has variable "STOP" -! which is an array of length 3 corresponding to day-of-year, hour, minute +! Initialized in namelist. time_step = set_time(assimilation_period_seconds, 0) end subroutine static_init_model @@ -361,9 +343,9 @@ end subroutine static_init_model ! Read the lon, lat, and alt arrays from the ncid -subroutine get_grid_from_netcdf(template_filename, lons, lats, alts ) +subroutine get_grid_from_netcdf(filter_io_filename, lons, lats, alts ) -character(len=*), intent(in) :: template_filename +character(len=*), intent(in) :: filter_io_filename real(r8), intent(inout) :: lons(:) real(r8), intent(inout) :: lats(:) real(r8), intent(inout) :: alts(:) @@ -372,7 +354,7 @@ subroutine get_grid_from_netcdf(template_filename, lons, lats, alts ) integer :: ncid -ncid = nc_open_file_readonly(template_filename, routine) +ncid = nc_open_file_readonly(filter_io_filename, routine) call nc_get_variable(ncid, LON_VAR_NAME, lons, routine) call nc_get_variable(ncid, LAT_VAR_NAME, lats, routine) @@ -387,6 +369,7 @@ end subroutine get_grid_from_netcdf subroutine static_init_blocks(restart_dirname) character(len=*), intent(in) :: restart_dirname +character(len=128) :: aether_filename character(len=*), parameter :: routine = 'static_init_blocks' @@ -403,17 +386,14 @@ subroutine static_init_blocks(restart_dirname) call read_model_namelist() ! error-check, convert namelist input to variable_table, and build the state structure -call verify_variables() -! TODO already wrong -print*,'static_init_blocks: post-verify_variables; nfields_neutral = ', nfields_neutral - +call make_variable_table() ! 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) ! TODO: Reading aether_to_dart_nml is done only in aether_to_dart? -! filter_inout_dir from here instead of redundant entry in model_mod_nml? +! filter_io_dir from here instead of redundant entry in model_mod_nml? ! ! Read the DART namelist for this model ! call find_namelist_in_file('input.nml', 'aether_to_dart_nml', iunit) ! read(iunit, nml = aether_to_dart_nml, iostat = io) @@ -423,24 +403,12 @@ subroutine static_init_blocks(restart_dirname) ! if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) ! if (do_nml_term()) write( * , nml=aether_to_dart_nml) -! Get the GITM variables in a restricted scope setting. - -! DONE(?): Replace nSpecies with Aether code -! nSpecies = get_nSpecies() -! nSpeciesTotal = get_nSpeciesTotal() -! nIons = get_nIons() -! nSpeciesAll = get_nSpeciesAll() -! DONE: These are calculated in get_grid_from_blocks -! nxPerBlock = get_nxPerBlock() -! nyPerBlock = get_nyPerBlock() -! nzPerBlock = get_nzPerBlock() - !--------------------------------------------------------------- ! Set the time step ... causes gitm namelists to be read. ! Ensures model_advance_time is multiple of 'dynamics_timestep' -!TODO: Aether uses Julian time -! or calendar (days from the start of the calendar), depending on the context) +!TODO: Aether uses Julian time internally +! andor a Julian calendar (days from the start of the calendar), depending on the context) call set_calendar_type( calendar ) ! comes from model_mod_nml !--------------------------------------------------------------- @@ -457,18 +425,21 @@ subroutine static_init_blocks(restart_dirname) call error_handler(E_MSG,routine,string1,source,revision,revdate) endif +! Opens and closes the grid block file, but not the filter netcdf file. call get_grid_from_blocks(restart_dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & nxPerBlock, nyPerBlock, nzPerBlock, lons, lats, alts ) -print*,'static_init_blocks: post-get_grid_from_blocks; nfields_neutral = ', nfields_neutral -! Opens and closes the grid block file, but not the restart_netcdf file. -! So it's not relevant to the _define problem. -! this is going to have to loop over all the blocks, both to get -! the data values and to get the full grid spacings. +! Convert the Aether reference date (not calendar day = 0 date) +! to the days and seconds of the calendar set in model_mod_nml. +aeth_ref_time = set_date(aeth_ref_date(1), aeth_ref_date(2), aeth_ref_date(3), & + aeth_ref_date(4), aeth_ref_date(5)) +call get_time(aeth_ref_time,aeth_ref_nsecs,aeth_ref_ndays) -state_time = get_state_time(restart_dirname) +! Get the model time from a restart file. +aether_filename = block_file_name(variable_table(1,VT_ORIGININDX), 0, 0) +state_time = read_model_time(trim(restart_dirname)//'/'//trim(aether_filename)) -! TODO: Replace with aether variables check? +! TODO: Replace with aether variables check? (OR is that done when trying to read them?) ! call verify_block_variables( gitm_block_variables, nfields ) ! ! do ivar = 1, nfields @@ -688,7 +659,7 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & real(r8), allocatable , dimension( : ), intent(inout) :: lons, lats, alts integer :: ios, nb, offset, ncid, nboff -character(len=256) :: filename +character(len=128) :: filename real(r4), allocatable :: temp(:,:,:) integer :: starts(3),ends(3), xcount, ycount, zcount @@ -697,7 +668,6 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & ! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), ! in order to calculate the n[xyz]PerBlock dimensions. ! grid_g0000.nc looks like a worthy candidate, but a restart could be used. -! (GITM got these numbers from a model module) write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' ncid = nc_open_file_readonly(filename, routine) @@ -761,7 +731,8 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & ! go across the south-most block row picking up all longitudes do nb = 1, nBlocksLon - ncid = open_block_file(dirname, 'grid', -1, nb-1, 'read', filename) + filename = block_file_name('grid', -1, nb-1) + ncid = open_block_file(trim(filename), 'read') ! Read 3D array and extract the longitudes of the non-halo data of this block. ! This gets nc_get_double_3d, even though the fields are float. @@ -798,20 +769,16 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & ! go up west-most block row picking up all latitudes do nb = 1, nBlocksLat - ! TODO; Aether block names start with 0, but the lat values can come from + ! TODO; Aether block name counters start with 0, but the lat values can come from ! any lon=const column. - ! orig: nboff = ((nb - 1) * nBlocksLon) + 1 nboff = ((nb - 1) * nBlocksLon) - ncid = open_block_file(dirname, 'grid', -1, nboff, 'read', filename) + filename = block_file_name('grid', -1, nboff) + ncid = open_block_file(trim(filename), 'read') call nc_get_variable(ncid, 'Latitude', & temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - routine, & - nc_count=(/zcount,ycount,xcount/)) -! nc_start=(/1,1,1/), & - -! call nc_get_variable(ncid, 'Latitude', temp, routine, nc_start=starts, & -! nc_count=(/xcount,ycount,zcount/)) + routine, nc_count=(/zcount,ycount,xcount/)) + ! if ( ios /= 0 ) then ! write(string1,*)'ERROR reading file ', trim(filename) ! write(string2,*)'latitude block ',nb,' of ',nBlocksLat @@ -830,15 +797,13 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & ! the same altitude array, so we can read it from the first block. ! if this is not the case, this code has to change. -ncid = open_block_file(dirname, 'grid', -1, 0, 'read', filename) +filename = block_file_name('grid', -1, 0) +ncid = open_block_file(trim(filename), 'read') -temp = -888888. +temp = MISSING_R8 call nc_get_variable(ncid, 'Altitude', & temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - routine, & - nc_count=(/zcount,ycount,xcount/)) -! nc_start=(/1,1,1/), & -! call nc_get_variable(ncid, 'Altitude', temp, routine, nc_start=starts) + routine, nc_count=(/zcount,ycount,xcount/)) alts(1:nzPerBlock) = temp(1:nzPerBlock,1,1) ! print*,'temp = ',temp(:,1,1) @@ -870,83 +835,43 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & end subroutine get_grid_from_blocks !================================================================== -! the static_init_model ensures that the gitm namelists are read. -! - -function get_state_time( dirname ) -type(time_type) :: get_state_time -character(len=*), intent(in) :: dirname - -type(time_type) :: base_time - -integer :: ncid, i, ios -integer :: tsimulation ! the time read from a restart file; seconds from aeth_ref_date. -integer :: ndays,nsecs, base_ndays, base_nsecs - -character(len=256) :: filename - -character(len=*), parameter :: routine = 'get_state_time' - -tsimulation = MISSING_R8 - -ncid = open_block_file(dirname, 'grid', -1, 0, 'read', filename) -call nc_get_variable(ncid, 'time', tsimulation, routine) -call nc_close_file(ncid, routine, filename) - -! Convert the Aether reference date (not calendar day = 0 date) -! to the days and seconds of the calendar set in model_mod_nml. -base_time = set_date(aeth_ref_date(1), aeth_ref_date(2), aeth_ref_date(3), & - aeth_ref_date(4), aeth_ref_date(5)) -call get_time(base_time,base_nsecs,base_ndays) -! Calculate the DART time of the file time. -ndays = tsimulation/86400 -nsecs = tsimulation - ndays*86400 -ndays = base_ndays + ndays -get_state_time = set_time(nsecs,ndays) +!> Create a filename from input file characteristics: +! filetype, member number, block number. +! filetype = {'grid','neutrals','ions', [...?]}. +! The first part of the name of the aether file to read. +! memnum or blocknum < 0 means don't include that part of the name. -if (do_output()) & - call print_time(get_state_time,'get_state_time: time in restart file '//filename) -if (do_output()) & - call print_date(get_state_time,'get_state_time: date in restart file '//filename) +function block_file_name(filetype, memnum, blocknum) -if (debug > 8) then - write(string1,*)'tsimulation ',tsimulation - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'ndays ',ndays - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'nsecs ',nsecs - call error_handler(E_MSG,routine,string1,source,revision,revdate) +character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} +! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? +! This code can handle it; a longer filetype passed in, and no member +! ? output files? +integer, intent(in) :: blocknum +integer, intent(in) :: memnum +character(len=128) :: block_file_name - call print_date( base_time, 'get_state_time:model base date') - call print_time( base_time, 'get_state_time:model base time') -endif +block_file_name = trim(filetype) +if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum +if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum +block_file_name = trim(block_file_name)//'.nc' +! TODO: Convert print to the error handler +print*,'filename, memnum, blocknum = ' ,trim(block_file_name), memnum, blocknum -end function get_state_time +end function block_file_name !================================================================== -!> open the requested block number restart file and return the ncid +!> open the requested restart file and return the ncid -function open_block_file(dirname, filetype, memnum, blocknum, rw, filename) +function open_block_file(filename,rw) -integer :: open_block_file -character(len=*), intent(in) :: dirname -character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} -! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? -! This code can handle it; a longer filetype passed in, and no member -! ? output files? -integer, intent(in) :: blocknum -integer, intent(in) :: memnum +character(len=*), intent(in) :: filename character(len=*), intent(in) :: rw ! 'read' or 'readwrite' -character(len=*), intent(out) :: filename -character(len=*), parameter :: routine = 'open_block_file' +integer :: open_block_file -filename = trim(dirname)//'/'//trim(filetype) -if (memnum >= 0) write(filename, '(A,A2,I0.4)') trim(filename), '_m', memnum -if (blocknum >= 0) write(filename, '(A,A2,I0.4)') trim(filename), '_g', blocknum -filename = trim(filename)//'.nc' -print*,'filename, memnum, blocknum = ' ,trim(filename), memnum, blocknum +character(len=*), parameter :: routine = 'open_block_file' if ( rw == 'read' .and. .not. file_exist(trim(filename)) ) then write(string1,*) 'cannot open file ', trim(filename),' for reading.' @@ -967,7 +892,6 @@ function open_block_file(dirname, filetype, memnum, blocknum, rw, filename) end function open_block_file - !================================================================= subroutine verify_block_variables( variable_array, ngood) @@ -1065,25 +989,17 @@ subroutine restart_files_to_netcdf(restart_dirname, member, netcdf_output_file) ! call add_nc_definitions(ncid) ! Enters and exits define mode; call nc_write_model_atts(ncid, 0) -print*,'Passed restart_files_to_netcdf:nc_write_model_atts' - -print*,'restart_files_to_netcdf: pre get_data; nfields_neutral = ',nfields_neutral call get_data(restart_dirname, ncid, member, define=.true.) -! TODO: remove? Done in get_data now -! call nc_end_define_mode(ncid) -! DONE: This has not been activated because the functionality is in TIEGCM's nc_write_model_atts +! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts ! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying ! the state vector field names and source. ! call add_nc_dimvars(ncid) call get_data(restart_dirname, ncid, member, define=.false.) -! DONE: this is done in static_init_blocks(?) -! call print_time(state_time) - -! TODO: this needs to be updated to write to time.json, not a NetCDF file. +! TODO: this needs to be updated to write to which file? ! call write_model_time(ncid, state_time) call nc_close_file(ncid) @@ -1125,14 +1041,14 @@ subroutine add_nc_definitions(ncid) call nc_define_dimension(ncid, LON_DIM_NAME, nlon) call nc_define_dimension(ncid, LAT_DIM_NAME, nlat) call nc_define_dimension(ncid, ALT_DIM_NAME, nalt) -! TODO: is WL in Aether? +! TODO: is WL in Aether? No; remove from model_mod. call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? !---------------------------------------------------------------------------- ! Create the (empty) Coordinate Variables and the Attributes !---------------------------------------------------------------------------- -! TODO: This defines more attributes than TIEGCM. Prefer? +! TODO: This defines more attributes than TIEGCM. Prefer? Are these accurate for Aether? ! Grid Longitudes call nc_define_double_variable(ncid, LON_VAR_NAME, (/ LON_DIM_NAME /) ) call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'type', 'x1d') @@ -1181,7 +1097,6 @@ subroutine get_data(dirname, ncid_output, member, define) character(len=256) :: filename -! get the dirname, construct the filenames inside open_block_file if (define) then ! if define, run one block. @@ -1251,7 +1166,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) ! treat alt specially since we want to derive TEC here -! TODO: do we? See density_ion_e too. +! TODO: See density_ion_e too. allocate( alt1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) ! temp array large enough to hold any 2D field @@ -1259,7 +1174,8 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) 1-nGhost:nxPerBlock+nGhost)) ! TODO: We need all altitudes, but there might be vertical blocks in the future. -! Keep the halo code here, but make nzcount adapt to whether there are blocks. +! But there would be no vertical halos. +! Make nzcount adapt to whether there are blocks. ! And temp needs to have C-ordering, which is what the restart files have. ! temp array large enough to hold 1 species, temperature, etc allocate(temp3d(1:nzPerBlock, & @@ -1279,7 +1195,8 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) ! 1-nGhost:nzPerBlock+nGhost, maxsize)) -! TODO; Does Aether need a replacement for these Density fields? +! TODO; Does Aether need a replacement for these Density fields? Yes. +! But they are probably read by the loops below. ! Don't need to fetch index because Aether has NetCDF restarts, ! so just loop over the field names to read. ! Read the index from the first species @@ -1325,7 +1242,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) ! ! data in the output file. loop over the index list in order. ! j = 1 ! ! TODO: electron density is not in the restart files, but it's needed for TEC -! In Aether they're from an ions file. +! In Aether they will be from an ions file, but now only from an output file (2023-10-30). ! do i = 1, nIons ! if (debug > 80) then ! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & @@ -1359,13 +1276,13 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) ! enddo ! endif -! TODO: Neutrals? In Aether they're from a different file. ! Handle the 2 restart file types (ions and neutrals). ! Each field has a file type associated with it: variable_table(f_index,VT_ORIGININDX) ! TODO: for now require that all neutrals are listed in variable_table before the ions. file_root = variable_table(1,VT_ORIGININDX) -ncid_input = open_block_file(dirname, file_root, member, nb, 'read', filename) +filename = block_file_name(file_root, member, nb) +ncid_input = open_block_file(trim(filename), 'read') print*,'read_data_from_block: nfields_neutral = ',nfields_neutral do ivar = 1, nfields_neutral @@ -1413,7 +1330,8 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) call nc_close_file(ncid_input) file_root = variable_table(nfields_neutral+1,VT_ORIGININDX) -ncid_input = open_block_file(dirname, file_root, member, nb, 'read', filename) +filename = block_file_name(file_root, member, nb) +ncid_input = open_block_file(trim(filename), 'read') print*,'read_data_from_block: nfields_ion = ',nfields_ion do ivar = nfields_neutral +1,nfields_neutral + nfields_ion @@ -1442,7 +1360,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) enddo call nc_close_file(ncid_input) -! TODO: Does Aether need TEC to be calculated? +! TODO: Does Aether need TEC to be calculated? Yes ! ! add the VTEC as an extended-state variable ! ! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program ! call get_index_from_gitm_varname('TEC', inum, ivals) @@ -1466,7 +1384,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) ! call unpack_data2d(temp2d, ivals(1), block, ncid, define) ! end if -! TODO: Does Aether need f10_7 to be calculated or processed? +! TODO: Does Aether need f10_7 to be calculated or processed? Yes ! read(iunit) temp0d ! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') ! call get_index_from_gitm_varname('f107', inum, ivals) @@ -1590,8 +1508,6 @@ subroutine unpack_data(data3d, ivar, block, ncid, define) integer, intent(in) :: ivar ! variable index integer, intent(in) :: block(2) integer, intent(in) :: ncid -! TODO: remove 'define' code -logical, intent(in) :: define integer :: ib, jb integer :: starts(3) @@ -1603,24 +1519,19 @@ subroutine unpack_data(data3d, ivar, block, ncid, define) write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) -if (define) then - -else - ib = block(1) - jb = block(2) - - ! to compute the start, consider (ib-1)*nxPerBlock+1 - starts(1) = 1 - starts(2) = (jb-1)*nyPerBlock+1 - starts(3) = (ib-1)*nxPerBlock+1 +ib = block(1) +jb = block(2) - call nc_put_variable(ncid, varname, & - data3d(1:nzPerBlock,1:nyPerBlock,1:nxPerBlock), & - context=routine, nc_start=starts, & - nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) - print*,'unpack_data: filled varname = ', varname +! to compute the start, consider (ib-1)*nxPerBlock+1 +starts(1) = 1 +starts(2) = (jb-1)*nyPerBlock+1 +starts(3) = (ib-1)*nxPerBlock+1 -end if +call nc_put_variable(ncid, varname, & + data3d(1:nzPerBlock,1:nyPerBlock,1:nxPerBlock), & + context=routine, nc_start=starts, & + nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) +print*,'unpack_data: filled varname = ', varname end subroutine unpack_data @@ -1671,185 +1582,186 @@ function get_model_size() end function get_model_size !================================================================== - -subroutine model_interpolate(state_handle, ens_size, location, iqty, obs_val, istatus) -! Given a location, and a model state variable qty, -! interpolates the state variable field to that location. -! obs_val is the interpolated value for each ensemble member -! istatus is the success (0) or failure of the interpolation - -type(ensemble_type), intent(in) :: state_handle -integer, intent(in) :: ens_size -type(location_type), intent(in) :: location -integer, intent(in) :: iqty -real(r8), intent(out) :: obs_val(ens_size) !< array of interpolated values -integer, intent(out) :: istatus(ens_size) - -integer :: which_vert -integer :: lat_below, lat_above, lon_below, lon_above ! these are indices -real(r8) :: lon_fract, lat_fract -real(r8) :: lon, lat, lon_lat_lev(3) -real(r8), dimension(ens_size) :: val11, val12, val21, val22 -real(r8) :: height -integer :: level, bogus_level -integer :: dom_id, var_id - -if ( .not. module_initialized ) call static_init_model - -! Default for failure return -istatus(:) = 1 -obs_val(:) = MISSING_R8 - -! Failure codes -! 11 QTY_GEOPOTENTIAL_HEIGHT is unsupported -! 22 unsupported veritcal coordinate -! 33 level given < or > model levels -! 44 quantity not part of the state -! 55 outside state (can not extrapolate above or below) -! 66 unknown vertical stagger - -! GITM uses a vtec routine in obs_def_upper_atm_mod:get_expected_gnd_gps_vtec() -! TIEGCM has its own vtec routine, so we should use it. This next block ensures that. -! The get_expected_gnd_gps_vtec() tries to interpolate QTY_GEOPOTENTIAL_HEIGHT -! when it does, this will kill it. - -if ( iqty == QTY_GEOPOTENTIAL_HEIGHT ) then - istatus(:) = 11 - write(string1,*)'QTY_GEOPOTENTIAL_HEIGHT currently unsupported' - call error_handler(E_ERR,'model_interpolate',string1,source, revision, revdate) -endif - - -! Get the position -lon_lat_lev = get_location(location) -lon = lon_lat_lev(1) ! degree -lat = lon_lat_lev(2) ! degree -height = lon_lat_lev(3) ! level (int) or height (real) -level = int(lon_lat_lev(3)) - - -which_vert = nint(query_location(location)) - -call compute_bracketing_lat_indices(lat, lat_below, lat_above, lat_fract) -call compute_bracketing_lon_indices(lon, lon_below, lon_above, lon_fract) - -! Pressure is not part of the state vector -! pressure is static data on plevs/pilevs -if ( iqty == QTY_PRESSURE) then - if (which_vert == VERTISLEVEL) then - ! @todo from Lanai code: - ! Some variables need plevs, some need pilevs - ! We only need the height (aka level) - ! the obs_def_upper_atm_mod.f90:get_expected_O_N2_ratio routines queries - ! for the pressure at the model levels - EXACTLY - so ... - ! FIXME ... at present ... the only time model_interpolate - ! gets called with QTY_PRESSURE is to calculate density, which - ! requires other variables that only live on the midpoints. - ! I cannot figure out how to generically decide when to - ! use plevs vs. pilevs - - ! Check to make sure vertical level is possible. - if ((level < 1) .or. (level > nalt)) then - istatus(:) = 33 - return - else - obs_val(:) = plevs(level) - istatus(:) = 0 - endif - elseif (which_vert == VERTISHEIGHT) then - - ! @todo from Lanai code: - ! FIXME ... is it possible to try to get a pressure with which_vert == undefined - ! At present, vert_interp will simply fail because height is a negative number. - ! @todo HK what are you supposed to do for pressure with VERTISUNDEF? level 1? - - call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) - if (any(istatus /= 0)) return ! bail at the first failure - call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) - if (any(istatus /= 0)) return - call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) - if (any(istatus /= 0)) return - call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) - obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) - else - - write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' - call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) - - endif ! which vert - - return - -endif ! end of QTY_PRESSURE - - -if ( iqty == QTY_VERTICAL_TEC ) then ! extrapolate vtec - - call extrapolate_vtec(state_handle, ens_size, lon_below, lat_below, val11) - call extrapolate_vtec(state_handle, ens_size, lon_below, lat_above, val11) - call extrapolate_vtec(state_handle, ens_size, lon_above, lat_below, val11) - call extrapolate_vtec(state_handle, ens_size, lon_above, lat_above, val11) - obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) - istatus(:) = 0 - - return -endif - -! check if qty is in the state vector -call find_qty_in_state(iqty, dom_id, var_id) -if (dom_id < 0 ) then - istatus(:) = 44 - return -endif - -if( which_vert == VERTISHEIGHT ) then - - call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) - if (any(istatus /= 0)) return ! bail at the first failure - call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) - if (any(istatus /= 0)) return - call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) - if (any(istatus /= 0)) return - call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) - obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) - istatus = 0 -elseif( which_vert == VERTISLEVEL) then - ! Check to make sure vertical level is possible. - if ((level < 1) .or. (level > nilev)) then - istatus(:) = 33 - return - endif - - ! one use of model_interpolate is to allow other modules/routines - ! the ability to 'count' the model levels. To do this, create observations - ! with locations on model levels and 'interpolate' for QTY_GEOMETRIC_HEIGHT. - ! When the interpolation fails, you've gone one level too far. - ! HK why does it have to be QTY_GEOMETRIC_HEIGHT? - - val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, level, domain_id(dom_id), var_id ), state_handle) - val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, level, domain_id(dom_id), var_id ), state_handle) - val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, level, domain_id(dom_id), var_id ), state_handle) - val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, level, domain_id(dom_id), var_id ), state_handle) - obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) - istatus = 0 - -elseif( which_vert == VERTISUNDEF) then - bogus_level = 1 !HK what should this be? Do only 2D fields have VERTISUNDEF? - val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) - val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) - val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) - val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) - obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) - istatus(:) = 0 - -else - - write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' - call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) - -endif - -end subroutine model_interpolate +! TODO; will be provided by Ben's model_mod. +! + subroutine model_interpolate(state_handle, ens_size, location, iqty, obs_val, istatus) + ! Given a location, and a model state variable qty, + ! interpolates the state variable field to that location. + ! obs_val is the interpolated value for each ensemble member + ! istatus is the success (0) or failure of the interpolation + + type(ensemble_type), intent(in) :: state_handle + integer, intent(in) :: ens_size + type(location_type), intent(in) :: location + integer, intent(in) :: iqty + real(r8), intent(out) :: obs_val(ens_size) !< array of interpolated values + integer, intent(out) :: istatus(ens_size) + + integer :: which_vert + integer :: lat_below, lat_above, lon_below, lon_above ! these are indices + real(r8) :: lon_fract, lat_fract + real(r8) :: lon, lat, lon_lat_lev(3) + real(r8), dimension(ens_size) :: val11, val12, val21, val22 + real(r8) :: height + integer :: level, bogus_level + integer :: dom_id, var_id +! +! if ( .not. module_initialized ) call static_init_model +! +! ! Default for failure return +! istatus(:) = 1 +! obs_val(:) = MISSING_R8 +! +! ! Failure codes +! ! 11 QTY_GEOPOTENTIAL_HEIGHT is unsupported +! ! 22 unsupported veritcal coordinate +! ! 33 level given < or > model levels +! ! 44 quantity not part of the state +! ! 55 outside state (can not extrapolate above or below) +! ! 66 unknown vertical stagger +! +! ! GITM uses a vtec routine in obs_def_upper_atm_mod:get_expected_gnd_gps_vtec() +! ! TIEGCM has its own vtec routine, so we should use it. This next block ensures that. +! ! The get_expected_gnd_gps_vtec() tries to interpolate QTY_GEOPOTENTIAL_HEIGHT +! ! when it does, this will kill it. +! +! if ( iqty == QTY_GEOPOTENTIAL_HEIGHT ) then +! istatus(:) = 11 +! write(string1,*)'QTY_GEOPOTENTIAL_HEIGHT currently unsupported' +! call error_handler(E_ERR,'model_interpolate',string1,source, revision, revdate) +! endif +! +! +! ! Get the position +! lon_lat_lev = get_location(location) +! lon = lon_lat_lev(1) ! degree +! lat = lon_lat_lev(2) ! degree +! height = lon_lat_lev(3) ! level (int) or height (real) +! level = int(lon_lat_lev(3)) +! +! +! which_vert = nint(query_location(location)) +! +! call compute_bracketing_lat_indices(lat, lat_below, lat_above, lat_fract) +! call compute_bracketing_lon_indices(lon, lon_below, lon_above, lon_fract) +! +! ! Pressure is not part of the state vector +! ! pressure is static data on plevs/pilevs +! if ( iqty == QTY_PRESSURE) then +! if (which_vert == VERTISLEVEL) then +! ! @todo from Lanai code: +! ! Some variables need plevs, some need pilevs +! ! We only need the height (aka level) +! ! the obs_def_upper_atm_mod.f90:get_expected_O_N2_ratio routines queries +! ! for the pressure at the model levels - EXACTLY - so ... +! ! FIXME ... at present ... the only time model_interpolate +! ! gets called with QTY_PRESSURE is to calculate density, which +! ! requires other variables that only live on the midpoints. +! ! I cannot figure out how to generically decide when to +! ! use plevs vs. pilevs +! +! ! Check to make sure vertical level is possible. +! if ((level < 1) .or. (level > nalt)) then +! istatus(:) = 33 +! return +! else +! obs_val(:) = plevs(level) +! istatus(:) = 0 +! endif +! elseif (which_vert == VERTISHEIGHT) then +! +! ! @todo from Lanai code: +! ! FIXME ... is it possible to try to get a pressure with which_vert == undefined +! ! At present, vert_interp will simply fail because height is a negative number. +! ! @todo HK what are you supposed to do for pressure with VERTISUNDEF? level 1? +! +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) +! if (any(istatus /= 0)) return ! bail at the first failure +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) +! if (any(istatus /= 0)) return +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) +! if (any(istatus /= 0)) return +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! else +! +! write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' +! call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) +! +! endif ! which vert +! +! return +! +! endif ! end of QTY_PRESSURE +! +! +! if ( iqty == QTY_VERTICAL_TEC ) then ! extrapolate vtec +! +! call extrapolate_vtec(state_handle, ens_size, lon_below, lat_below, val11) +! call extrapolate_vtec(state_handle, ens_size, lon_below, lat_above, val11) +! call extrapolate_vtec(state_handle, ens_size, lon_above, lat_below, val11) +! call extrapolate_vtec(state_handle, ens_size, lon_above, lat_above, val11) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! istatus(:) = 0 +! +! return +! endif +! +! ! check if qty is in the state vector +! call find_qty_in_state(iqty, dom_id, var_id) +! if (dom_id < 0 ) then +! istatus(:) = 44 +! return +! endif +! +! if( which_vert == VERTISHEIGHT ) then +! +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) +! if (any(istatus /= 0)) return ! bail at the first failure +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) +! if (any(istatus /= 0)) return +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) +! if (any(istatus /= 0)) return +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! istatus = 0 +! elseif( which_vert == VERTISLEVEL) then +! ! Check to make sure vertical level is possible. +! if ((level < 1) .or. (level > nilev)) then +! istatus(:) = 33 +! return +! endif +! +! ! one use of model_interpolate is to allow other modules/routines +! ! the ability to 'count' the model levels. To do this, create observations +! ! with locations on model levels and 'interpolate' for QTY_GEOMETRIC_HEIGHT. +! ! When the interpolation fails, you've gone one level too far. +! ! HK why does it have to be QTY_GEOMETRIC_HEIGHT? +! +! val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, level, domain_id(dom_id), var_id ), state_handle) +! val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, level, domain_id(dom_id), var_id ), state_handle) +! val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, level, domain_id(dom_id), var_id ), state_handle) +! val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, level, domain_id(dom_id), var_id ), state_handle) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! istatus = 0 +! +! elseif( which_vert == VERTISUNDEF) then +! bogus_level = 1 !HK what should this be? Do only 2D fields have VERTISUNDEF? +! val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) +! val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) +! val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) +! val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! istatus(:) = 0 +! +! else +! +! write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' +! call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) +! +! endif +! + end subroutine model_interpolate !------------------------------------------------------------------------------- function shortest_time_between_assimilations() @@ -1860,53 +1772,53 @@ function shortest_time_between_assimilations() end function shortest_time_between_assimilations !================================================================== - -subroutine get_state_meta_data(index_in, location, var_qty) -! Given an integer index into the state vector, returns the -! associated location and optionally the variable quantity. - -integer(i8), intent(in) :: index_in -type(location_type), intent(out) :: location -integer, optional, intent(out) :: var_qty - -integer :: lon_index, lat_index, lev_index -integer :: local_qty, var_id, dom_id -integer :: seconds, days ! for f10.7 location -real(r8) :: longitude ! for f10.7 location -character(len=NF90_MAX_NAME) :: dim_name - -if ( .not. module_initialized ) call static_init_model - -call get_model_variable_indices(index_in, lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id, kind_index=local_qty) - -if(present(var_qty)) var_qty = local_qty - -if (get_variable_name(dom_id, var_id) == 'f10_7') then - ! f10_7 is most accurately located at local noon at equator. - ! 360.0 degrees in 86400 seconds, 43200 secs == 12:00 UTC == longitude 0.0 - - call get_time(state_time, seconds, days) - longitude = 360.0_r8 * real(seconds,r8) / 86400.0_r8 - 180.0_r8 - if (longitude < 0.0_r8) longitude = longitude + 360.0_r8 - location = set_location(longitude, 0.0_r8, 400000.0_r8, VERTISUNDEF) - return -end if - -! search for either ilev or lev -dim_name = ilev_or_lev(dom_id, var_id) - -select case (trim(dim_name)) - case ('ilev') - location = set_location(lons(lon_index), lats(lat_index), ilevs(lev_index), VERTISLEVEL) - case (ALT_DIM_NAME) - location = set_location(lons(lon_index), lats(lat_index), alts(lev_index), VERTISLEVEL) - case default - call error_handler(E_ERR, 'get_state_meta_data', 'expecting ilev or ilat dimension') - ! HK @todo 2D variables. -end select - -end subroutine get_state_meta_data - +! + subroutine get_state_meta_data(index_in, location, var_qty) + ! Given an integer index into the state vector, returns the + ! associated location and optionally the variable quantity. + + integer(i8), intent(in) :: index_in + type(location_type), intent(out) :: location + integer, optional, intent(out) :: var_qty + + integer :: lon_index, lat_index, lev_index + integer :: local_qty, var_id, dom_id + integer :: seconds, days ! for f10.7 location + real(r8) :: longitude ! for f10.7 location + character(len=NF90_MAX_NAME) :: dim_name + +! if ( .not. module_initialized ) call static_init_model +! +! call get_model_variable_indices(index_in, lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id, kind_index=local_qty) +! +! if(present(var_qty)) var_qty = local_qty +! +! if (get_variable_name(dom_id, var_id) == 'f10_7') then +! ! f10_7 is most accurately located at local noon at equator. +! ! 360.0 degrees in 86400 seconds, 43200 secs == 12:00 UTC == longitude 0.0 +! +! call get_time(state_time, seconds, days) +! longitude = 360.0_r8 * real(seconds,r8) / 86400.0_r8 - 180.0_r8 +! if (longitude < 0.0_r8) longitude = longitude + 360.0_r8 +! location = set_location(longitude, 0.0_r8, 400000.0_r8, VERTISUNDEF) +! return +! end if +! +! ! search for either ilev or lev +! dim_name = ilev_or_lev(dom_id, var_id) +! +! select case (trim(dim_name)) +! case ('ilev') +! location = set_location(lons(lon_index), lats(lat_index), ilevs(lev_index), VERTISLEVEL) +! case (ALT_DIM_NAME) +! location = set_location(lons(lon_index), lats(lat_index), alts(lev_index), VERTISLEVEL) +! case default +! call error_handler(E_ERR, 'get_state_meta_data', 'expecting ilev or ilat dimension') +! ! HK @todo 2D variables. +! end select +! + end subroutine get_state_meta_data + !================================================================== subroutine end_model() @@ -1928,9 +1840,6 @@ subroutine nc_write_model_atts( ncid, dom_id) if ( .not. module_initialized ) call static_init_model ! Write Global Attributes -! TODO: trying to run showed that this file is already in define mode. -! I haven't tracked down whether it should have been taken out. -! call nc_begin_define_mode(ncid, routine) call nc_add_global_creation_time(ncid, routine) @@ -2035,6 +1944,7 @@ end subroutine nc_write_model_atts !================================================================== +! TODO: this will be replaced by Ben. ! Vertical localization is done only in height (ZG). ! obs vertical location is given in height (model_interpolate). ! state vertical location is given in height. @@ -2053,50 +1963,50 @@ subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & integer :: n integer :: istatus -n = size(locs) - -if (vertical_localization_on()) then ! need to get height - call convert_vertical_state(state_handle, n, locs, loc_qtys, loc_indx, VERTISHEIGHT, istatus) ! HK Do we care about istatus? -endif - -call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & - num_close, close_ind, dist) - -! Make the ZG part of the state vector far from everything so it does not get updated. -! HK Note if you have inflation on ZG has been inflated. -! Scroll through all the obs_loc(:) and obs_kind(:) elements - -do k = 1,num_close - q_ind = close_ind(k) - if (loc_qtys(q_ind) == QTY_GEOMETRIC_HEIGHT) then - if (do_output() .and. (debug > 99)) then - write( * ,*)'get_close_state ZG distance is ', & - dist(k),' changing to ',10.0_r8 * PI - write(logfileunit,*)'get_close_state ZG distance is ', & - dist(k),' changing to ',10.0_r8 * PI - endif - dist(k) = 10.0_r8 * PI - endif -enddo - - -if (estimate_f10_7) then -! f10_7 is given a location of latitude 0.0 and the longitude -! of local noon. By decreasing the distance from the observation -! to the dynamic f10_7 location we are allowing the already close -! observations to have a larger impact in the parameter estimation. -! 0.25 is heuristic. The 'close' observations have already been -! determined by the cutoff. Changing the distance here does not -! allow more observations to impact anything. - do k = 1, num_close - q_ind = close_ind(k) - if (loc_qtys(q_ind) == QTY_1D_PARAMETER) then - dist(k) = dist(k)*0.25_r8 - endif - enddo -endif - - +! n = size(locs) +! +! if (vertical_localization_on()) then ! need to get height +! call convert_vertical_state(state_handle, n, locs, loc_qtys, loc_indx, VERTISHEIGHT, istatus) ! HK Do we care about istatus? +! endif +! +! call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & +! num_close, close_ind, dist) +! +! ! Make the ZG part of the state vector far from everything so it does not get updated. +! ! HK Note if you have inflation on ZG has been inflated. +! ! Scroll through all the obs_loc(:) and obs_kind(:) elements +! +! do k = 1,num_close +! q_ind = close_ind(k) +! if (loc_qtys(q_ind) == QTY_GEOMETRIC_HEIGHT) then +! if (do_output() .and. (debug > 99)) then +! write( * ,*)'get_close_state ZG distance is ', & +! dist(k),' changing to ',10.0_r8 * PI +! write(logfileunit,*)'get_close_state ZG distance is ', & +! dist(k),' changing to ',10.0_r8 * PI +! endif +! dist(k) = 10.0_r8 * PI +! endif +! enddo +! +! +! if (estimate_f10_7) then +! ! f10_7 is given a location of latitude 0.0 and the longitude +! ! of local noon. By decreasing the distance from the observation +! ! to the dynamic f10_7 location we are allowing the already close +! ! observations to have a larger impact in the parameter estimation. +! ! 0.25 is heuristic. The 'close' observations have already been +! ! determined by the cutoff. Changing the distance here does not +! ! allow more observations to impact anything. +! do k = 1, num_close +! q_ind = close_ind(k) +! if (loc_qtys(q_ind) == QTY_1D_PARAMETER) then +! dist(k) = dist(k)*0.25_r8 +! endif +! enddo +! endif +! +! end subroutine get_close_state !================================================================== @@ -2118,138 +2028,128 @@ subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, & character(len=*), parameter :: routine = 'convert_vertical_obs' -if ( which_vert == VERTISHEIGHT .or. which_vert == VERTISUNDEF) then - istatus(:) = 0 - return -endif - -do i = 1, num - current_vert_type = nint(query_location(locs(i))) - if (( current_vert_type == which_vert ) .or. & - ( current_vert_type == VERTISUNDEF)) then - istatus(i) = 0 - cycle - endif - - call model_interpolate(state_handle, 1, locs(i), QTY_GEOMETRIC_HEIGHT, height, local_status ) - - if (local_status(1) == 0) call set_vertical(locs(i), height(1), VERTISHEIGHT) - istatus(i) = local_status(1) - -enddo - +! if ( which_vert == VERTISHEIGHT .or. which_vert == VERTISUNDEF) then +! istatus(:) = 0 +! return +! endif +! +! do i = 1, num +! current_vert_type = nint(query_location(locs(i))) +! if (( current_vert_type == which_vert ) .or. & +! ( current_vert_type == VERTISUNDEF)) then +! istatus(i) = 0 +! cycle +! endif +! +! call model_interpolate(state_handle, 1, locs(i), QTY_GEOMETRIC_HEIGHT, height, local_status ) +! +! if (local_status(1) == 0) call set_vertical(locs(i), height(1), VERTISHEIGHT) +! istatus(i) = local_status(1) +! +! enddo +! end subroutine convert_vertical_obs !================================================================== - -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 - -integer :: var_id, dom_id, lon_index, lat_index, lev_index -integer :: i -real(r8) :: height(1), height1(1), height2(1) -character(len=NF90_MAX_NAME) :: dim_name -integer(i8) :: height_idx - - -if ( which_vert /= VERTISHEIGHT ) then - call error_handler(E_ERR,'convert_vertical_state', 'only supports VERTISHEIGHT') -endif - -istatus = 0 !HK what are you doing with this? - -do i = 1, num - - call get_model_variable_indices(loc_indx(i), lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id) - - ! search for either ilev or lev - dim_name = ilev_or_lev(dom_id, var_id) - - select case (trim(dim_name)) - case ('ilev') - height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & - domain_id(SECONDARY_DOM), ivarZG) - height = get_state(height_idx, state_handle)/100.0_r8 - - case (ALT_DIM_NAME) ! height on midpoint - height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & - domain_id(SECONDARY_DOM), ivarZG) - height1 = get_state(height_idx, state_handle)/100.0_r8 - height_idx = get_dart_vector_index(lon_index, lat_index, lev_index+1, & - domain_id(SECONDARY_DOM), ivarZG) - height2 = get_state(height_idx, state_handle)/100.0_r8 - height = (height1 + height2) / 2.0_r8 - - case default - call error_handler(E_ERR, 'convert_vertical_state', 'expecting ilev or ilat dimension') - end select - - locs(i) = set_location(lons(lon_index), lats(lat_index), height(1), VERTISHEIGHT) - -end do - + 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 + + integer :: var_id, dom_id, lon_index, lat_index, lev_index + integer :: i + real(r8) :: height(1), height1(1), height2(1) + character(len=NF90_MAX_NAME) :: dim_name + integer(i8) :: height_idx + + +! if ( which_vert /= VERTISHEIGHT ) then +! call error_handler(E_ERR,'convert_vertical_state', 'only supports VERTISHEIGHT') +! endif +! +! istatus = 0 !HK what are you doing with this? +! +! do i = 1, num +! +! call get_model_variable_indices(loc_indx(i), lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id) +! +! ! search for either ilev or lev +! dim_name = ilev_or_lev(dom_id, var_id) +! +! select case (trim(dim_name)) +! case ('ilev') +! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & +! domain_id(SECONDARY_DOM), ivarZG) +! height = get_state(height_idx, state_handle)/100.0_r8 +! +! case (ALT_DIM_NAME) ! height on midpoint +! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & +! domain_id(SECONDARY_DOM), ivarZG) +! height1 = get_state(height_idx, state_handle)/100.0_r8 +! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index+1, & +! domain_id(SECONDARY_DOM), ivarZG) +! height2 = get_state(height_idx, state_handle)/100.0_r8 +! height = (height1 + height2) / 2.0_r8 +! +! case default +! call error_handler(E_ERR, 'convert_vertical_state', 'expecting ilev or ilat dimension') +! end select +! +! locs(i) = set_location(lons(lon_index), lats(lat_index), height(1), VERTISHEIGHT) +! +! end do +! end subroutine convert_vertical_state -!------------------------------------------------------------------------------- -! Called from static_init_model. -! TODO: probably needs to be updated like get_state_time, which is called by static_init_blocks. +!================================================================== function read_model_time(filename) -character(len=*), intent(in) :: filename -type(time_type) :: read_model_time +type(time_type) :: read_model_time +character(len=*), intent(in) :: filename -integer :: ncid, time_dimlen, dimlen - -integer, parameter :: nmtime = 3 -integer, dimension(nmtime) :: mtime ! day, hour, minute -integer :: year, doy, utsec -integer, allocatable, dimension(:,:) :: mtimetmp -integer, allocatable, dimension(:) :: yeartmp +integer :: ncid, i, ios +integer :: tsimulation ! the time read from a restart file; seconds from aeth_ref_date. +integer :: ndays,nsecs character(len=*), parameter :: routine = 'read_model_time' -ncid = nc_open_file_readonly(trim(filename), routine) - -time_dimlen = nc_get_dimension_size(ncid, 'time', routine) -dimlen = nc_get_dimension_size(ncid, 'mtimedim', routine) +tsimulation = MISSING_I -if (dimlen /= nmtime) then - write(string1, *) trim(filename), ' mtimedim = ',dimlen, ' DART expects ', nmtime - call error_handler(E_ERR,'read_model_time',string1,source,revision,revdate) -endif - -allocate(mtimetmp(dimlen, time_dimlen), yeartmp(time_dimlen)) - -call nc_get_variable(ncid, 'mtime', mtimetmp, routine) -call nc_get_variable(ncid, 'year', yeartmp, routine) +ncid = open_block_file(filename, 'read') +call nc_get_variable(ncid, 'time', tsimulation, routine) +call nc_close_file(ncid, routine, filename) -! pick off the latest/last -mtime = mtimetmp(:,time_dimlen) -year = yeartmp( time_dimlen) +! Calculate the DART time of the file time. +! TODO: review calculation of ndays in read_model_time +ndays = tsimulation/86400 +nsecs = tsimulation - ndays*86400 +! Need to subtract 1 because the ref day is not finished. +ndays = aeth_ref_ndays -1 + ndays +read_model_time = set_time(nsecs,ndays) -deallocate(mtimetmp,yeartmp) +if (do_output()) & + call print_time(read_model_time,'read_model_time: time in restart file '//filename) +if (do_output()) & + call print_date(read_model_time,'read_model_time: date in restart file '//filename) -doy = mtime(1) -utsec = (mtime(2)*60 + mtime(3))*60 -read_model_time = set_time(utsec, doy-1) + set_date(year, 1, 1) ! Jan 1 of whatever year. +if (debug > 8) then + write(string1,*)'tsimulation ',tsimulation + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*)'ndays ',ndays + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*)'nsecs ',nsecs + call error_handler(E_MSG,routine,string1,source,revision,revdate) -if (do_output()) then - write(*,*) trim(filename)//':read_model_time: tiegcm [year, doy, hour, minute]', & - year, mtime - call print_date(read_model_time, str=trim(filename)//':read_model_time: date ') - call print_time(read_model_time, str=trim(filename)//':read_model_time: time ') + call print_date( aeth_ref_time, 'read_model_time:model base date') + call print_time( aeth_ref_time, 'read_model_time:model base time') endif -call nc_close_file(ncid, routine, filename) - end function read_model_time @@ -2257,101 +2157,13 @@ end function read_model_time ! Routines below here are private to the module !=============================================================================== -! TODO; Not called anymore. Has all functionality been replaced? -subroutine read_TIEGCM_definition(file_name) -! Read TIEGCM grid definition from a tiegcm restart file -! fills metadata storage variables: -! lons(:), nlon -! lats(:), nlat -! lev(:), nalt -! ilev(:), nilev -! plevs(:) -! pilevs(:) -! Converts the tiegcm longitude (-+180) to (0 360) -! Sets the grid specs - -character(len=*), intent(in) :: file_name -integer :: ncid, DimID, TimeDimID -real(r8) :: p0 - -character(len=*), parameter :: routine = 'read_TIEGCM_definition' - -call error_handler(E_MSG,routine,'reading restart ['//trim(file_name)//']') - -ncid = nc_open_file_readonly(file_name, routine) - -! longitude - TIEGCM uses values +/- 180, DART uses values [0,360] -nlon = nc_get_dimension_size(ncid, LON_DIM_NAME, routine) -allocate(lons(nlon)) -call nc_get_variable(ncid, LON_DIM_NAME, lons, routine) -where (lons < 0.0_r8) lons = lons + 360.0_r8 - -! latitiude -nlat = nc_get_dimension_size(ncid, LAT_DIM_NAME, routine) -allocate(lats(nlat)) -call nc_get_variable(ncid, LAT_DIM_NAME, lats, routine) - -! pressure -call nc_get_variable(ncid, 'p0', p0, routine) -TIEGCM_reference_pressure = p0 - -! level -all_nalt = nc_get_dimension_size(ncid, ALT_DIM_NAME, routine) -! top level is not viable. The lower boundary condition is stored in the top level -nalt = all_nalt - 1 -allocate(all_alts(all_nalt),alts(nalt), plevs(nalt)) -call nc_get_variable(ncid, ALT_DIM_NAME, all_alts, routine) - -alts=all_alts(1:nalt) -! TODO: in tiegcm levs was assumed to be pressure, but aether uses altitude, -! so this should probably be plevs; derive it from alts. -plevs = p0 * exp(-plevs) * 100.0_r8 ![Pa] = 100* [millibars] = 100* [hPa] - -! ilevel -nilev = nc_get_dimension_size(ncid, 'ilev', routine) -allocate(ilevs(nilev), pilevs(nilev)) -call nc_get_variable(ncid, 'ilev', ilevs, routine) - -pilevs = p0 * exp(-ilevs) * 100.0_r8 ! [Pa] = 100* [millibars] = 100* [hPa] - -if ((nalt+1) .ne. nilev) then - write(string1,*) 'number of midpoints should be 1 less than number of interfaces.' !HK is the top level for nilev not a boundary condition? - write(string2,*) 'number of midpoints is nalt = ',nalt - write(string3,*) 'number of interfaces is nilev = ',nilev - call error_handler(E_MSG,'read_TIEGCM_definition', string1, & - source, revision, revdate, text2=string2, text3=string3) -endif - - -! Get lon and lat grid specs -bot_lon = lons(1) ! 180. -delta_lon = abs((lons(1)-lons(2))) ! 5. or 2.5 -zero_lon_index = int(bot_lon/delta_lon) + 1 ! 37 or 73 -top_lon = lons(nlon) ! 175. or 177.5 -bot_lat = lats(1) ! -top_lat = lats(nlat) ! -delta_lat = abs((lats(1)-lats(2))) ! - -end subroutine read_TIEGCM_definition - -!================================================================== - -! TODO: this TIEGCM (generic DART subr?) is kept in preference to gitm's set_gitm_variable_info, -! but we need to check the functionality, esp. the domains at the end. -! Do we need to read in "variables" from somewhere and then translate into variable_table? -! Or can the model_nml namelist read _table directly? -! Maybe 2D arrays in namelists don't work; read 1D and translate to 2D - ! Fill up the variable_table from the namelist item 'variables' ! The namelist item variables is where a user specifies ! which variables they want in the DART state: ! variable name, dart qty, clamping min, clamping max, origin file, update or not -subroutine verify_variables() +subroutine make_variable_table() -! TODO: is this making them local variables and implicitly reinitializing them to 0? -! integer :: nfields_neutral ! number of variables from restart file -! integer :: nfields_ion ! number of variables from secondary file integer :: nfields_constructed ! number of constructed state variables integer :: i, nrows, ncols @@ -2378,6 +2190,7 @@ subroutine verify_variables() nfields = 0 ! TODO: TIEGCM uses 3 domains. Aether may need only 1: +! Do we need the 3rd category for derived fields; TEC, ...? nfields_neutral = 0 nfields_ion = 0 nfields_constructed = 0 @@ -2391,9 +2204,7 @@ subroutine verify_variables() filename = trim(variables(ncols*i - 1)) state_or_aux = trim(variables(ncols*i )) -! TODO: does filename need to be upper case for some reason? -! Aether doesn't want it to be. -! call to_upper(filename) +! TODO: should Aether use the 6th column of namelist variable input to handle TEC, ...? call to_upper(state_or_aux) ! update or not variable_table(i,VT_VARNAMEINDX) = trim(varname) @@ -2432,7 +2243,7 @@ subroutine verify_variables() else print*,'variable_table(',i, VT_ORIGININDX,') = ', trim(variable_table(i,VT_ORIGININDX)) endif - print*,'verify_variables: nfields = ',nfields, nfields_neutral, nfields_ion + print*,'make_variable_table: nfields = ',nfields, nfields_neutral, nfields_ion enddo ROWLOOP @@ -2456,24 +2267,6 @@ subroutine verify_variables() enddo endif -! TODO: Does Aether need ZG (gravity at the top altitude?) -! if (nfields_ion == 0) call error_handler(E_ERR, 'ZG is required in &model_nml::variables', source) - -! TODO: TIEGCM uses 3 domains, so this section may need to be modified to look more like gitm's: -! ! gitm only has a single domain (only a single grid, no nests or multiple grids) -! -! domain_id = add_domain(template_filename, nfields, var_names, kind_list, & -! clamp_vals, update_list) -! !domain_id = add_domain(nfields, var_names, kind_list, & -! ! clamp_vals, update_list) -! -! if (debug > 1) call state_structure_info(domain_id) -! -! end subroutine set_gitm_variable_info -! -! call load_up_state_structure_from_file(aether_restart_file_name, nfields_neutral, 'RESTART', RESTART_DOM) -! call load_up_state_structure_from_file(aether_secondary_file_name, nfields_ion, 'SECONDARY', SECONDARY_DOM) - ! TODO: Aether may need something like this. ! if (estimate_f10_7) then ! if (nfields_constructed == 0) then @@ -2486,262 +2279,249 @@ subroutine verify_variables() ! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) ! endif ! -! ! set ivar. ZG is in the secondary domain -! ivarZG = get_varid_from_varname(domain_id(SECONDARY_DOM), 'ZG') - -end subroutine verify_variables - -!================================================================== - -! Adds a domain to the state structure from a netcdf file -! Called from verify_variables -subroutine load_up_state_structure_from_file(filename, nvar, domain_name, domain_num) - -character(len=*), intent(in) :: filename ! filename to read from -integer, intent(in) :: nvar ! number of variables in domain -character(len=*), intent(in) :: domain_name ! restart, secondary -integer, intent(in) :: domain_num - -integer :: i,j - -character(len=NF90_MAX_NAME), allocatable :: var_names(:) -real(r8), allocatable :: clamp_vals(:,:) -integer, allocatable :: kind_list(:) -logical, allocatable :: update_list(:) - - -allocate(var_names(nvar), kind_list(nvar), & - clamp_vals(nvar,2), update_list(nvar)) - -update_list(:) = .true. ! default to update state variable -clamp_vals(:,:) = MISSING_R8 ! default to no clamping - -j = 0 -do i = 1, nfields - if (variable_table(i,VT_ORIGININDX) == trim(domain_name)) then - j = j+1 - var_names(j) = variable_table(i, VT_VARNAMEINDX) - kind_list(j) = get_index_for_quantity(variable_table(i, VT_KINDINDX)) - if (variable_table(i, VT_MINVALINDX) /= 'NA') then - read(variable_table(i, VT_MINVALINDX), '(d16.8)') clamp_vals(j,1) - endif - if (variable_table(i, VT_MAXVALINDX) /= 'NA') then - read(variable_table(i, VT_MAXVALINDX), '(d16.8)') clamp_vals(j,2) - endif - if (variable_table(i, VT_STATEINDX) == 'NO_COPY_BACK') then - update_list(j) = .false. - endif - endif -enddo - -domain_id(domain_num) = add_domain(filename, nvar, & - var_names, kind_list, clamp_vals, update_list) - -! remove top level from all lev variables - this is the boundary condition -call hyperslice_domain(domain_id(domain_num), ALT_DIM_NAME, nalt) - -deallocate(var_names, kind_list, clamp_vals, update_list) - -end subroutine load_up_state_structure_from_file +end subroutine make_variable_table !================================================================== - -subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) -! -! Create the vTEC from constituents in state. -! - -type(ensemble_type), intent(in) :: state_handle -integer, intent(in) :: ens_size -integer, intent(in) :: lon_index, lat_index -real(r8), intent(out) :: vTEC(ens_size) - -! n(i)levs x ensmeble size -real(r8), allocatable, dimension(:,:) :: NE, ZG -real(r8), allocatable, dimension(:,:) :: TI, TE -real(r8), allocatable, dimension(:,:) :: NEm_extended, ZG_extended -real(r8), allocatable, dimension(:,:) :: delta_ZG, NE_middle -real(r8), dimension(ens_size) :: GRAVITYtop, Tplasma, Hplasma - -real(r8), PARAMETER :: k_constant = 1.381e-23_r8 ! m^2 * kg / s^2 / K -real(r8), PARAMETER :: omass = 2.678e-26_r8 ! mass of atomic oxgen kg - -real(r8) :: earth_radiusm -integer :: naltX, nilevX, j, i, var_id -integer(i8) :: idx - -! NE,ZG are extrapolated -! 20 more layers for 2.5 degree resolution -! 10 more layers for 5 degree resolution -if (model_res == 2.5) then - naltX = nalt + 20 - nilevX = nilev + 20 -else - naltX = nalt + 10 - nilevX = nilev + 10 -endif - - -allocate( NE(nilev, ens_size), NEm_extended(nilevX, ens_size), & - ZG(nilev, ens_size), ZG_extended(nilevX, ens_size)) -allocate( TI(nalt, ens_size), TE(nalt, ens_size) ) -allocate( delta_ZG(naltX-1, ens_size), NE_middle(naltX-1, ens_size) ) - -! NE (interfaces) -var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'NE') -do i = 1, nilev - idx = get_dart_vector_index(lon_index,lat_index, i, & - domain_id(RESTART_DOM), var_id) - NE(i, :) = get_state(idx, state_handle) -enddo - -! ZG (interfaces) -do i = 1, nilev - idx = get_dart_vector_index(lon_index,lat_index, i, & - domain_id(RESTART_DOM), var_id) - ZG(i, :) = get_state(idx, state_handle) -enddo - -! TI (midpoints) -var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TI') -do i = 1, nalt - idx = get_dart_vector_index(lon_index,lat_index, i, & - domain_id(RESTART_DOM), var_id) - TI(i, :) = get_state(idx, state_handle) -enddo - -! TE (midpoints) -var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TE') -do i = 1, nalt - idx = get_dart_vector_index(lon_index,lat_index, i, & - domain_id(RESTART_DOM), var_id) - TE(i, :) = get_state(idx, state_handle) -enddo - -! Construct vTEC given the parts - -earth_radiusm = earth_radius * 1000.0_r8 ! Convert earth_radius in km to m -NE = NE * 1.0e+6_r8 ! Convert NE in #/cm^3 to #/m^3 - -! Gravity at the top layer -GRAVITYtop(:) = gravity * (earth_radiusm / (earth_radiusm + ZG(nilev,:))) ** 2 - -! Plasma Temperature -Tplasma(:) = (TI(nalt-1,:) + TE(nalt-1,:)) / 2.0_r8 - -! Compute plasma scale height -Hplasma(:) = (2.0_r8 * k_constant / omass ) * Tplasma(:) / GRAVITYtop(:) - -ZG_extended(1:nilev,:) = ZG -NEm_extended(1:nilev,:) = NE - -do j = nalt, naltX - NEm_extended(j,:) = NEm_extended(j-1,:) * exp(-0.5_r8) - ZG_extended(j,:) = ZG_extended(j-1,:) + Hplasma(:) / 2.0_r8 -enddo - -delta_ZG(1:(naltX-1),:) = ZG_extended(2:naltX,:) - ZG_extended(1:(naltX-1),:) -NE_middle(1:(naltX-1),:) = (NEm_extended(2:naltX,:) + NEm_extended(1:(naltX-1),:)) / 2.0_r8 - -do i = 1, ens_size - vTEC(i) = sum(NE_middle(:,i) * delta_ZG(:,i)) * 1.0e-16_r8 ! Convert to TECU (1.0e+16 #/m^2) -enddo - -deallocate( NE, NEm_extended, ZG, ZG_extended) -deallocate( TI, TE ) -deallocate( delta_ZG, NE_middle ) - -end subroutine extrapolate_vtec - +! +! ! Adds a domain to the state structure from a netcdf file +! ! Called from make_variable_table +! subroutine load_up_state_structure_from_file(filename, nvar, domain_name, domain_num) +! +! character(len=*), intent(in) :: filename ! filename to read from +! integer, intent(in) :: nvar ! number of variables in domain +! character(len=*), intent(in) :: domain_name ! restart, secondary +! integer, intent(in) :: domain_num +! +! integer :: i,j +! +! character(len=NF90_MAX_NAME), allocatable :: var_names(:) +! real(r8), allocatable :: clamp_vals(:,:) +! integer, allocatable :: kind_list(:) +! logical, allocatable :: update_list(:) +! +! +! allocate(var_names(nvar), kind_list(nvar), & +! clamp_vals(nvar,2), update_list(nvar)) +! +! update_list(:) = .true. ! default to update state variable +! clamp_vals(:,:) = MISSING_R8 ! default to no clamping +! +! j = 0 +! do i = 1, nfields +! if (variable_table(i,VT_ORIGININDX) == trim(domain_name)) then +! j = j+1 +! var_names(j) = variable_table(i, VT_VARNAMEINDX) +! kind_list(j) = get_index_for_quantity(variable_table(i, VT_KINDINDX)) +! if (variable_table(i, VT_MINVALINDX) /= 'NA') then +! read(variable_table(i, VT_MINVALINDX), '(d16.8)') clamp_vals(j,1) +! endif +! if (variable_table(i, VT_MAXVALINDX) /= 'NA') then +! read(variable_table(i, VT_MAXVALINDX), '(d16.8)') clamp_vals(j,2) +! endif +! if (variable_table(i, VT_STATEINDX) == 'NO_COPY_BACK') then +! update_list(j) = .false. +! endif +! endif +! enddo +! +! domain_id(domain_num) = add_domain(filename, nvar, & +! var_names, kind_list, clamp_vals, update_list) +! +! ! remove top level from all lev variables - this is the boundary condition +! call hyperslice_domain(domain_id(domain_num), ALT_DIM_NAME, nalt) +! +! deallocate(var_names, kind_list, clamp_vals, update_list) +! +! end subroutine load_up_state_structure_from_file +! !================================================================== - -subroutine vert_interp(state_handle, n, dom_id, var_id, lon_index, lat_index, height, iqty, & - val, istatus) -! returns the value at an arbitrary height on an existing horizontal grid location. -! istatus == 0 is success. - -type(ensemble_type), intent(in) :: state_handle -integer, intent(in) :: n ! ensemble_size -integer, intent(in) :: dom_id -integer, intent(in) :: var_id -integer, intent(in) :: lon_index -integer, intent(in) :: lat_index -real(r8), intent(in) :: height -integer, intent(in) :: iqty -real(r8), intent(out) :: val(n) -integer, intent(out) :: istatus(n) - -logical :: is_pressure -character(len=NF90_MAX_NAME) :: vertstagger - -! Presume the worst. Failure. -istatus = 1 -val = MISSING_R8 - -is_pressure = (iqty == QTY_PRESSURE) -if (is_pressure) then - vertstagger = 'ilev' -else - vertstagger = ilev_or_lev(dom_id, var_id) -endif - -if (vertstagger == 'ilev') then - call vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pressure, & - dom_id, var_id, val, istatus) -elseif (vertstagger == ALT_DIM_NAME) then - call vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & - dom_id, var_id, val, istatus) -endif - -end subroutine vert_interp - +! +! subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) +! ! +! ! Create the vTEC from constituents in state. +! ! +! +! type(ensemble_type), intent(in) :: state_handle +! integer, intent(in) :: ens_size +! integer, intent(in) :: lon_index, lat_index +! real(r8), intent(out) :: vTEC(ens_size) +! +! ! n(i)levs x ensmeble size +! real(r8), allocatable, dimension(:,:) :: NE +! real(r8), allocatable, dimension(:,:) :: TI, TE +! real(r8), allocatable, dimension(:,:) :: NEm_extended +! real(r8), allocatable, dimension(:,:) :: NE_middle +! real(r8), dimension(ens_size) :: GRAVITYtop, Tplasma, Hplasma +! +! real(r8), PARAMETER :: k_constant = 1.381e-23_r8 ! m^2 * kg / s^2 / K +! real(r8), PARAMETER :: omass = 2.678e-26_r8 ! mass of atomic oxgen kg +! +! real(r8) :: earth_radiusm +! integer :: naltX, nilevX, j, i, var_id +! integer(i8) :: idx +! +! ! NE are extrapolated +! ! 20 more layers for 2.5 degree resolution +! ! 10 more layers for 5 degree resolution +! if (model_res == 2.5) then +! naltX = nalt + 20 +! nilevX = nilev + 20 +! else +! naltX = nalt + 10 +! nilevX = nilev + 10 +! endif +! +! +! allocate( NE(nilev, ens_size), NEm_extended(nilevX, ens_size)) +! allocate( TI(nalt, ens_size), TE(nalt, ens_size) ) +! allocate( NE_middle(naltX-1, ens_size) ) +! +! ! NE (interfaces) +! var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'NE') +! do i = 1, nilev +! idx = get_dart_vector_index(lon_index,lat_index, i, & +! domain_id(RESTART_DOM), var_id) +! NE(i, :) = get_state(idx, state_handle) +! enddo +! +! ! TI (midpoints) +! var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TI') +! do i = 1, nalt +! idx = get_dart_vector_index(lon_index,lat_index, i, & +! domain_id(RESTART_DOM), var_id) +! TI(i, :) = get_state(idx, state_handle) +! enddo +! +! ! TE (midpoints) +! var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TE') +! do i = 1, nalt +! idx = get_dart_vector_index(lon_index,lat_index, i, & +! domain_id(RESTART_DOM), var_id) +! TE(i, :) = get_state(idx, state_handle) +! enddo +! +! ! Construct vTEC given the parts +! +! earth_radiusm = earth_radius * 1000.0_r8 ! Convert earth_radius in km to m +! NE = NE * 1.0e+6_r8 ! Convert NE in #/cm^3 to #/m^3 +! +! ! Gravity at the top layer +! ! GRAVITYtop(:) = gravity * (earth_radiusm / (earth_radiusm + ZG(nilev,:))) ** 2 +! +! ! Plasma Temperature +! Tplasma(:) = (TI(nalt-1,:) + TE(nalt-1,:)) / 2.0_r8 +! +! ! Compute plasma scale height +! Hplasma(:) = (2.0_r8 * k_constant / omass ) * Tplasma(:) / GRAVITYtop(:) +! +! NEm_extended(1:nilev,:) = NE +! +! do j = nalt, naltX +! NEm_extended(j,:) = NEm_extended(j-1,:) * exp(-0.5_r8) +! enddo +! +! NE_middle(1:(naltX-1),:) = (NEm_extended(2:naltX,:) + NEm_extended(1:(naltX-1),:)) / 2.0_r8 +! +! do i = 1, ens_size +! ! vTEC(i) = sum(NE_middle(:,i) * delta_ZG(:,i)) * 1.0e-16_r8 ! Convert to TECU (1.0e+16 #/m^2) +! vTEC(i) = sum(NE_middle(:,i) ) * 1.0e-16_r8 ! Convert to TECU (1.0e+16 #/m^2) +! enddo +! +! deallocate( NE, NEm_extended) +! deallocate( TI, TE ) +! deallocate( NE_middle ) +! +! end subroutine extrapolate_vtec +! +! !================================================================== +! +! subroutine vert_interp(state_handle, n, dom_id, var_id, lon_index, lat_index, height, iqty, & +! val, istatus) +! ! returns the value at an arbitrary height on an existing horizontal grid location. +! ! istatus == 0 is success. +! +! type(ensemble_type), intent(in) :: state_handle +! integer, intent(in) :: n ! ensemble_size +! integer, intent(in) :: dom_id +! integer, intent(in) :: var_id +! integer, intent(in) :: lon_index +! integer, intent(in) :: lat_index +! real(r8), intent(in) :: height +! integer, intent(in) :: iqty +! real(r8), intent(out) :: val(n) +! integer, intent(out) :: istatus(n) +! +! logical :: is_pressure +! character(len=NF90_MAX_NAME) :: vertstagger +! +! ! Presume the worst. Failure. +! istatus = 1 +! val = MISSING_R8 +! +! is_pressure = (iqty == QTY_PRESSURE) +! if (is_pressure) then +! vertstagger = 'ilev' +! else +! vertstagger = ilev_or_lev(dom_id, var_id) +! endif +! +! if (vertstagger == 'ilev') then +! call vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pressure, & +! dom_id, var_id, val, istatus) +! elseif (vertstagger == ALT_DIM_NAME) then +! call vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & +! dom_id, var_id, val, istatus) +! endif +! +! end subroutine vert_interp +! !================================================================== - -subroutine find_qty_in_state(iqty, which_dom, var_id) -! Returns the variable id for a given DART qty -! Will return X rather than X_MN variable. - -integer, intent(in) :: iqty -integer, intent(out) :: which_dom -integer, intent(out) :: var_id - -integer :: num_same_kind, id, k -integer, allocatable :: multiple_kinds(:), n -character(NF90_MAX_NAME) :: varname - -which_dom = -1 -var_id = -1 - -do id = 1, get_num_domains() ! RESTART_DOM, SECONDARY_DOM, CONSTRUCT_DOM - - num_same_kind = get_num_varids_from_kind(domain_id(id), iqty) - if (num_same_kind == 0 ) cycle - if (num_same_kind > 1 ) then ! need to pick which one you want - which_dom = id - allocate(multiple_kinds(num_same_kind)) - call get_varids_from_kind(domain_id(id), iqty, multiple_kinds) - do k = 1, num_same_kind - varname = adjustl(get_variable_name(domain_id(id), multiple_kinds(k))) - n = len(trim(varname)) - if (n <= 2) then ! variable name can not be X_MN - var_id = multiple_kinds(k) - exit - elseif (trim(varname(n-2:n)) == '_NM') then ! variable name is _MN - cycle ! assuming we want the X, not the X_MN - else - var_id = multiple_kinds(k) - exit - endif - enddo - deallocate(multiple_kinds) - else ! - which_dom = id - var_id = get_varid_from_kind(domain_id(id), iqty) - endif -enddo - -end subroutine find_qty_in_state - +! +! subroutine find_qty_in_state(iqty, which_dom, var_id) +! ! Returns the variable id for a given DART qty +! ! Will return X rather than X_MN variable. +! +! integer, intent(in) :: iqty +! integer, intent(out) :: which_dom +! integer, intent(out) :: var_id +! +! integer :: num_same_kind, id, k +! integer, allocatable :: multiple_kinds(:), n +! character(NF90_MAX_NAME) :: varname +! +! which_dom = -1 +! var_id = -1 +! +! do id = 1, get_num_domains() ! RESTART_DOM, SECONDARY_DOM, CONSTRUCT_DOM +! +! num_same_kind = get_num_varids_from_kind(domain_id(id), iqty) +! if (num_same_kind == 0 ) cycle +! if (num_same_kind > 1 ) then ! need to pick which one you want +! which_dom = id +! allocate(multiple_kinds(num_same_kind)) +! call get_varids_from_kind(domain_id(id), iqty, multiple_kinds) +! do k = 1, num_same_kind +! varname = adjustl(get_variable_name(domain_id(id), multiple_kinds(k))) +! n = len(trim(varname)) +! if (n <= 2) then ! variable name can not be X_MN +! var_id = multiple_kinds(k) +! exit +! elseif (trim(varname(n-2:n)) == '_NM') then ! variable name is _MN +! cycle ! assuming we want the X, not the X_MN +! else +! var_id = multiple_kinds(k) +! exit +! endif +! enddo +! deallocate(multiple_kinds) +! else ! +! which_dom = id +! var_id = get_varid_from_kind(domain_id(id), iqty) +! endif +! enddo +! +! end subroutine find_qty_in_state +! !================================================================== ! find enclosing lon indices @@ -2771,295 +2551,194 @@ subroutine compute_bracketing_lon_indices(lon, idx_below, idx_above, fraction) end subroutine compute_bracketing_lon_indices !================================================================== - -! on ilev -subroutine vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pressure, & - dom_id, var_id, val, istatus) - -type(ensemble_type), intent(in) :: state_handle -real(r8), intent(in) :: height -integer, intent(in) :: n ! ensemble size -integer, intent(in) :: lon_index -integer, intent(in) :: lat_index -logical, intent(in) :: is_pressure -integer, intent(in) :: dom_id, var_id -real(r8), intent(out) :: val(n) ! interpolated value -integer, intent(out) :: istatus(n) - -integer :: lev_bottom(n) -integer :: lev_top(n) -real(r8) :: frac_lev(n) -integer :: k, i -real(r8) :: zgrid(n), delta_z(n), z2(n), zgrid_top(n), zgrid_bottom(n) -logical :: found(n) ! track which ensemble members have been located -real(r8) :: val_top(n), val_bottom(n) -integer(i8) :: indx_top(n), indx_bottom(n) ! state vector indice - -istatus = 1 -found = .false. - - zgrid_bottom(:) = get_state(get_dart_vector_index(lon_index,lat_index,1, & - domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 - zgrid_top(:) = get_state(get_dart_vector_index(lon_index,lat_index, nilev, & - domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 - - ! cannot extrapolate below bottom or beyond top - do i = 1, n - if ((zgrid_bottom(i) > height) .or. (zgrid_top(i) < height)) then - istatus(i) = 55 - endif - enddo - if (any(istatus == 55)) return ! fail if any ensemble member fails - - ! Figure out what level is above/below, and by how much - h_loop_interface : do k = 2, nilev - - zgrid(:) = get_state(get_dart_vector_index(lon_index,lat_index,k, & - domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 - - ! per ensemble member - do i = 1, n - if (found(i)) cycle - if (height <= zgrid(i)) then - found(i) = .true. - lev_top(i) = k - lev_bottom(i) = lev_top(i) - 1 - if (all(found)) exit h_loop_interface - endif - enddo - - enddo h_loop_interface - - do i = 1, n - indx_top(i) = get_dart_vector_index(lon_index,lat_index,lev_top(i), domain_id(SECONDARY_DOM), ivarZG) - indx_bottom(i) = get_dart_vector_index(lon_index,lat_index,lev_bottom(i), domain_id(SECONDARY_DOM), ivarZG) - enddo - - call get_state_array(zgrid(:), indx_top(:), state_handle) - - call get_state_array(z2(:), indx_bottom(:), state_handle) - - where (zgrid == z2) ! avoid divide by zero - frac_lev = 0.0_r8 - delta_z = 0.0_r8 - elsewhere - delta_z = (zgrid - z2)/100.0_r8 - frac_lev = (zgrid/100.0_r8 - height)/delta_z - endwhere - - if (is_pressure) then ! get fom plevs (pilevs?) array @todo HK Lanai is always plves - - val_top(:) = plevs(lev_top(:)) !pressure at midpoint [Pa] - val_bottom(:) = plevs(lev_bottom(:)) !pressure at midpoint [Pa] - val(:) = exp(frac_lev(:) * log(val_bottom(:)) + (1.0 - frac_lev(:)) * log(val_top(:))) - - else ! get from state vector - - do i = 1, n - indx_top(i) = get_dart_vector_index(lon_index,lat_index,lev_top(i), dom_id, var_id) - indx_bottom(i) = get_dart_vector_index(lon_index,lat_index,lev_bottom(i), dom_id, var_id) - enddo - - call get_state_array(val_top, indx_top(:), state_handle) - call get_state_array(val_bottom, indx_bottom(:), state_handle) - - val(:) = frac_lev(:) * val_bottom(:) + (1.0 - frac_lev(:)) * val_top(:) - - endif - - istatus(:) = 0 - -end subroutine vert_interp_ilev - -!================================================================== - -! on lev -subroutine vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & - dom_id, var_id, val, istatus) - -type(ensemble_type), intent(in) :: state_handle -real(r8), intent(in) :: height -integer, intent(in) :: n ! ensemble size -integer, intent(in) :: lon_index -integer, intent(in) :: lat_index -logical, intent(in) :: is_pressure -integer, intent(in) :: dom_id, var_id -real(r8), intent(out) :: val(n) ! interpolated value -integer, intent(out) :: istatus(n) - -integer :: lev(n), lev_minus_one(n), lev_plus_one(n) -real(r8) :: frac_lev(n) - -integer :: k, i -real(r8) :: delta_z(n) -real(r8) :: zgrid_upper(n), zgrid_lower(n) ! ZG on midpoints -real(r8) :: z_k(n), z_k_minus_one(n), z_k_plus_one(n) ! ZG on ilves -integer(i8) :: indx_top(n), indx_bottom(n) ! state vector indices for qty -integer(i8) :: indx(n), indx_minus_one(n), indx_plus_one(n) ! state vector indices for ZG -logical :: found(n) ! track which ensemble members have been located -real(r8) :: val_top(n), val_bottom(n) - -istatus = 1 -found = .false. - - ! Variable is on level midpoints, not ilevels. - ! Get height as the average of the ilevels. - - ! ilev index 1 2 3 4 ... 27 28 29 - ! ilev value -7.00, -6.50, -6.00, -5.50, ... 6.00, 6.50, 7.00 ; - ! lev value -6.75, -6.25, -5.75, -5.25, ... 6.25, 6.75 - ! lev index 1 2 3 4 ... 27 28 - - !mid_level 1 - zgrid_lower(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,1, & - domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & - (get_state(get_dart_vector_index(lon_index,lat_index,2, & - domain_id(SECONDARY_DOM), ivarZG), state_handle) /100.0_r8) ) / 2.0_r8 - - !mid_level nalt - zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,nilev-1, & - domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & - (get_state(get_dart_vector_index(lon_index,lat_index,nilev, & - domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) ) / 2.0_r8 - - ! cannot extrapolate below bottom or beyond top - do i = 1, n - if ((zgrid_lower(i) > height) .or. (zgrid_upper(i) < height)) then - istatus(i) = 55 - endif - enddo - if (any(istatus == 55)) return ! ! fail if any ensemble member fails - - ! Figure out what level is above/below, and by how much - h_loop_midpoint: do k = 2, nilev-1 - - zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,k, & - domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 ) + & - (get_state(get_dart_vector_index(lon_index,lat_index,k+1, & - domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) ) / 2.0_r8 - - ! per ensemble member - do i = 1, n - if (found(i)) cycle - if (height <= zgrid_upper(i)) then - found(i) = .true. - lev(i) = k - lev_minus_one(i) = lev(i) - 1 - lev_plus_one(i) = lev(i) + 1 - if (all(found)) exit h_loop_midpoint - endif - enddo - - enddo h_loop_midpoint - - do i = 1, n - indx(i) = get_dart_vector_index(lon_index,lat_index,lev(i), domain_id(SECONDARY_DOM), ivarZG) - indx_minus_one(i) = get_dart_vector_index(lon_index,lat_index,lev_minus_one(i), domain_id(SECONDARY_DOM), ivarZG) - indx_plus_one(i) = get_dart_vector_index(lon_index,lat_index,lev_plus_one(i), domain_id(SECONDARY_DOM), ivarZG) - enddo - - call get_state_array(z_k(:),indx(:), state_handle) - call get_state_array(z_k_minus_one, indx_minus_one(:), state_handle) - call get_state_array(z_k_plus_one, indx_plus_one(:), state_handle) - - - !lower midpoint - zgrid_lower(:) = ( z_k(:) + z_k_minus_one ) / 2.0_r8 / 100.0_r8 - - ! upper midpoint - zgrid_upper(:) = ( z_k(:) + z_k_plus_one ) / 2.0_r8 / 100.0_r8 - - where (zgrid_upper == zgrid_lower) ! avoid divide by zero - frac_lev = 0.0_r8 - delta_z = 0.0_r8 - elsewhere - delta_z = zgrid_upper - zgrid_lower - frac_lev = (zgrid_upper - height)/delta_z - endwhere - -if (is_pressure) then ! get fom plevs - - val_top(:) = plevs(lev(:)) !pressure at midpoint [Pa] - val_bottom(:) = plevs(lev_minus_one(:)) !pressure at midpoint [Pa] - val(:) = exp(frac_lev(:) * log(val_bottom(:)) + (1.0 - frac_lev(:)) * log(val_top(:))) - -else ! get from state vector - - do i = 1, n - indx_top(i) = get_dart_vector_index(lon_index,lat_index,lev(i), dom_id, var_id) - indx_bottom(i) = get_dart_vector_index(lon_index,lat_index,lev_minus_one(i), dom_id, var_id) - enddo - - call get_state_array(val_top, indx_top(:), state_handle) - call get_state_array(val_bottom, indx_bottom(:), state_handle) - - val(:) = frac_lev(:) * val_bottom(:) + (1.0 - frac_lev(:)) * val_top(:) - -endif - -istatus(:) = 0 - -end subroutine vert_interp_lev - -!================================================================== - -! Compute neighboring lat rows: TIEGCM [-87.5, 87.5] DART [-90, 90] -! Poles >|87.5| set to |87.5| -subroutine compute_bracketing_lat_indices(lat, idx_below, idx_above, fraction) - -real(r8), intent(in) :: lat ! latitude -integer, intent(out) :: idx_below, idx_above ! index in lats() -real(r8), intent(out) :: fraction ! fraction to use for interpolation - -if(lat >= bot_lat .and. lat < top_lat) then ! -87.5 <= lat < 87.5 - idx_below = int((lat - bot_lat) / delta_lat) + 1 - idx_above = idx_below + 1 - fraction = (lat - lats(idx_below) ) / delta_lat -else if(lat < bot_lat) then ! South of bottom lat - idx_below = 1 - idx_above = 1 - fraction = 1.0_r8 -else ! On or North of top lat - idx_below = nlat - idx_above = nlat - fraction = 1.0_r8 -endif - -end subroutine compute_bracketing_lat_indices - -!------------------------------------------------------------------------------- -function interpolate(n, lon_fract, lat_fract, val11, val12, val21, val22) result(obs_val) - -integer, intent(in) :: n ! number of ensemble members -real(r8), intent(in) :: lon_fract, lat_fract -real(r8), dimension(n), intent(in) :: val11, val12, val21, val22 -real(r8), dimension(n) :: obs_val - -real(r8) :: a(n, 2) - -a(:, 1) = lon_fract * val21(:) + (1.0_r8 - lon_fract) * val11(:) -a(:, 2) = lon_fract * val22(:) + (1.0_r8 - lon_fract) * val12(:) - -obs_val(:) = lat_fract * a(:,2) + (1.0_r8 - lat_fract) * a(:,1) - -end function interpolate - -!------------------------------------------------------------------------------- -function ilev_or_lev(dom_id, var_id) result(dim_name) - -integer, intent(in) :: dom_id -integer, intent(in) :: var_id -character(len=NF90_MAX_NAME) :: dim_name - -integer :: d -! search for either ilev or lev -dim_name = 'null' -do d = 1, get_num_dims(dom_id, var_id) - dim_name = get_dim_name(dom_id, var_id, d) - if (dim_name == 'ilev' .or. dim_name == ALT_DIM_NAME) exit -enddo - -end function ilev_or_lev +! +! ! on lev +! subroutine vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & +! dom_id, var_id, val, istatus) +! +! type(ensemble_type), intent(in) :: state_handle +! real(r8), intent(in) :: height +! integer, intent(in) :: n ! ensemble size +! integer, intent(in) :: lon_index +! integer, intent(in) :: lat_index +! logical, intent(in) :: is_pressure +! integer, intent(in) :: dom_id, var_id +! real(r8), intent(out) :: val(n) ! interpolated value +! integer, intent(out) :: istatus(n) +! +! integer :: lev(n), lev_minus_one(n), lev_plus_one(n) +! real(r8) :: frac_lev(n) +! +! integer :: k, i +! real(r8) :: delta_z(n) +! real(r8) :: zgrid_upper(n), zgrid_lower(n) ! ZG on midpoints +! real(r8) :: z_k(n), z_k_minus_one(n), z_k_plus_one(n) ! ZG on ilves +! integer(i8) :: indx_top(n), indx_bottom(n) ! state vector indices for qty +! integer(i8) :: indx(n), indx_minus_one(n), indx_plus_one(n) ! state vector indices for ZG +! logical :: found(n) ! track which ensemble members have been located +! real(r8) :: val_top(n), val_bottom(n) +! +! istatus = 1 +! found = .false. +! +! ! Variable is on level midpoints, not ilevels. +! ! Get height as the average of the ilevels. +! +! ! ilev index 1 2 3 4 ... 27 28 29 +! ! ilev value -7.00, -6.50, -6.00, -5.50, ... 6.00, 6.50, 7.00 ; +! ! lev value -6.75, -6.25, -5.75, -5.25, ... 6.25, 6.75 +! ! lev index 1 2 3 4 ... 27 28 +! +! !mid_level 1 +! zgrid_lower(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,1, & +! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & +! (get_state(get_dart_vector_index(lon_index,lat_index,2, & +! domain_id(SECONDARY_DOM), ivarZG), state_handle) /100.0_r8) ) / 2.0_r8 +! +! !mid_level nalt +! zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,nilev-1, & +! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & +! (get_state(get_dart_vector_index(lon_index,lat_index,nilev, & +! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) ) / 2.0_r8 +! +! ! cannot extrapolate below bottom or beyond top +! do i = 1, n +! if ((zgrid_lower(i) > height) .or. (zgrid_upper(i) < height)) then +! istatus(i) = 55 +! endif +! enddo +! if (any(istatus == 55)) return ! ! fail if any ensemble member fails +! +! ! Figure out what level is above/below, and by how much +! h_loop_midpoint: do k = 2, nilev-1 +! +! zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,k, & +! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 ) + & +! (get_state(get_dart_vector_index(lon_index,lat_index,k+1, & +! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) ) / 2.0_r8 +! +! ! per ensemble member +! do i = 1, n +! if (found(i)) cycle +! if (height <= zgrid_upper(i)) then +! found(i) = .true. +! lev(i) = k +! lev_minus_one(i) = lev(i) - 1 +! lev_plus_one(i) = lev(i) + 1 +! if (all(found)) exit h_loop_midpoint +! endif +! enddo +! +! enddo h_loop_midpoint +! +! do i = 1, n +! indx(i) = get_dart_vector_index(lon_index,lat_index,lev(i), domain_id(SECONDARY_DOM), ivarZG) +! indx_minus_one(i) = get_dart_vector_index(lon_index,lat_index,lev_minus_one(i), domain_id(SECONDARY_DOM), ivarZG) +! indx_plus_one(i) = get_dart_vector_index(lon_index,lat_index,lev_plus_one(i), domain_id(SECONDARY_DOM), ivarZG) +! enddo +! +! call get_state_array(z_k(:),indx(:), state_handle) +! call get_state_array(z_k_minus_one, indx_minus_one(:), state_handle) +! call get_state_array(z_k_plus_one, indx_plus_one(:), state_handle) +! +! +! !lower midpoint +! zgrid_lower(:) = ( z_k(:) + z_k_minus_one ) / 2.0_r8 / 100.0_r8 +! +! ! upper midpoint +! zgrid_upper(:) = ( z_k(:) + z_k_plus_one ) / 2.0_r8 / 100.0_r8 +! +! where (zgrid_upper == zgrid_lower) ! avoid divide by zero +! frac_lev = 0.0_r8 +! delta_z = 0.0_r8 +! elsewhere +! delta_z = zgrid_upper - zgrid_lower +! frac_lev = (zgrid_upper - height)/delta_z +! endwhere +! +! if (is_pressure) then ! get fom plevs +! +! val_top(:) = plevs(lev(:)) !pressure at midpoint [Pa] +! val_bottom(:) = plevs(lev_minus_one(:)) !pressure at midpoint [Pa] +! val(:) = exp(frac_lev(:) * log(val_bottom(:)) + (1.0 - frac_lev(:)) * log(val_top(:))) +! +! else ! get from state vector +! +! do i = 1, n +! indx_top(i) = get_dart_vector_index(lon_index,lat_index,lev(i), dom_id, var_id) +! indx_bottom(i) = get_dart_vector_index(lon_index,lat_index,lev_minus_one(i), dom_id, var_id) +! enddo +! +! call get_state_array(val_top, indx_top(:), state_handle) +! call get_state_array(val_bottom, indx_bottom(:), state_handle) +! +! val(:) = frac_lev(:) * val_bottom(:) + (1.0 - frac_lev(:)) * val_top(:) +! +! endif +! +! istatus(:) = 0 +! +! end subroutine vert_interp_lev +! +! !================================================================== +! +! ! Compute neighboring lat rows: TIEGCM [-87.5, 87.5] DART [-90, 90] +! ! Poles >|87.5| set to |87.5| +! subroutine compute_bracketing_lat_indices(lat, idx_below, idx_above, fraction) +! +! real(r8), intent(in) :: lat ! latitude +! integer, intent(out) :: idx_below, idx_above ! index in lats() +! real(r8), intent(out) :: fraction ! fraction to use for interpolation +! +! if(lat >= bot_lat .and. lat < top_lat) then ! -87.5 <= lat < 87.5 +! idx_below = int((lat - bot_lat) / delta_lat) + 1 +! idx_above = idx_below + 1 +! fraction = (lat - lats(idx_below) ) / delta_lat +! else if(lat < bot_lat) then ! South of bottom lat +! idx_below = 1 +! idx_above = 1 +! fraction = 1.0_r8 +! else ! On or North of top lat +! idx_below = nlat +! idx_above = nlat +! fraction = 1.0_r8 +! endif +! +! end subroutine compute_bracketing_lat_indices +! +! !------------------------------------------------------------------------------- +! function interpolate(n, lon_fract, lat_fract, val11, val12, val21, val22) result(obs_val) +! +! integer, intent(in) :: n ! number of ensemble members +! real(r8), intent(in) :: lon_fract, lat_fract +! real(r8), dimension(n), intent(in) :: val11, val12, val21, val22 +! real(r8), dimension(n) :: obs_val +! +! real(r8) :: a(n, 2) +! +! a(:, 1) = lon_fract * val21(:) + (1.0_r8 - lon_fract) * val11(:) +! a(:, 2) = lon_fract * val22(:) + (1.0_r8 - lon_fract) * val12(:) +! +! obs_val(:) = lat_fract * a(:,2) + (1.0_r8 - lat_fract) * a(:,1) +! +! end function interpolate +! +! !------------------------------------------------------------------------------- +! function ilev_or_lev(dom_id, var_id) result(dim_name) +! +! integer, intent(in) :: dom_id +! integer, intent(in) :: var_id +! character(len=NF90_MAX_NAME) :: dim_name +! +! integer :: d +! ! search for either ilev or lev +! dim_name = 'null' +! do d = 1, get_num_dims(dom_id, var_id) +! dim_name = get_dim_name(dom_id, var_id, d) +! if (dim_name == 'ilev' .or. dim_name == ALT_DIM_NAME) exit +! enddo +! +! end function ilev_or_lev !=============================================================================== ! End of model_mod !=============================================================================== diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index df67994069..87f22bc734 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -1,7 +1,7 @@ ! TIEGCM: (Any variables from GITM?) &model_nml debug = 100 - filter_inout_dir = 'testdata1/restartOut.Sphere.1member' + filter_io_dir = 'testdata1/restartOut.Sphere.1member' estimate_f10_7 = .false. f10_7_file_name = 'f10_7.nc' variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', From b8fab472446c0e731abec3a4756c2266d062bfdb Mon Sep 17 00:00:00 2001 From: kdraeder Date: Wed, 1 Nov 2023 14:14:12 -0600 Subject: [PATCH 049/124] Rearranged routines into public, private This should be done before dart_to_aether and merging. No functional changes, in order to make a clean transition. Diffuse won't be able to easily show functional changes from the previous commit. Moved private routines to the private section, public to public, and a new initialization section. Removed unused sortindexlist. Tested. --- ...o_aether.f90.notyet => dart_to_aether.f90} | 0 models/aether_lon-lat/model_mod.f90 | 3248 ++++++++--------- 2 files changed, 1609 insertions(+), 1639 deletions(-) rename models/aether_lon-lat/{dart_to_aether.f90.notyet => dart_to_aether.f90} (100%) diff --git a/models/aether_lon-lat/dart_to_aether.f90.notyet b/models/aether_lon-lat/dart_to_aether.f90 similarity index 100% rename from models/aether_lon-lat/dart_to_aether.f90.notyet rename to models/aether_lon-lat/dart_to_aether.f90 diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 0838a14f14..63a4f291a4 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -267,6 +267,9 @@ module model_mod real(r8) :: LatStart=MISSING_R8, LatEnd=MISSING_R8, LonStart=MISSING_R8 contains + +!=============================================================================== +! Routines in this section (down to "private") are public. !=============================================================================== subroutine static_init_model() @@ -341,1945 +344,1912 @@ end subroutine static_init_model !================================================================== -! Read the lon, lat, and alt arrays from the ncid - -subroutine get_grid_from_netcdf(filter_io_filename, lons, lats, alts ) - -character(len=*), intent(in) :: filter_io_filename -real(r8), intent(inout) :: lons(:) -real(r8), intent(inout) :: lats(:) -real(r8), intent(inout) :: alts(:) +!> Create a filename from input file characteristics: +! filetype, member number, block number. +! filetype = {'grid','neutrals','ions', [...?]}. +! The first part of the name of the aether file to read. +! memnum or blocknum < 0 means don't include that part of the name. -character(len=*), parameter :: routine = 'get_grid_from_netcdf' +function block_file_name(filetype, memnum, blocknum) -integer :: ncid +character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} +! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? +! This code can handle it; a longer filetype passed in, and no member +! ? output files? +integer, intent(in) :: blocknum +integer, intent(in) :: memnum +character(len=128) :: block_file_name -ncid = nc_open_file_readonly(filter_io_filename, routine) +block_file_name = trim(filetype) +if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum +if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum +block_file_name = trim(block_file_name)//'.nc' +! TODO: Convert print to the error handler +print*,'filename, memnum, blocknum = ' ,trim(block_file_name), memnum, blocknum -call nc_get_variable(ncid, LON_VAR_NAME, lons, routine) -call nc_get_variable(ncid, LAT_VAR_NAME, lats, routine) -call nc_get_variable(ncid, ALT_VAR_NAME, alts, routine) +end function block_file_name -call nc_close_file(ncid) +!================================================================== +!> Converts Aether restart files to a netCDF file +!> Modified from models/gitm/model_mod.f90 +!> +!> This routine needs: +!> +!> 1. A base dirname for the restart files (restart_dirname). +!> they will have the format 'dirname/bNNNN.rst' where NNNN has +!> leading 0s and is the block number. Blocks start in the +!> southwest corner of the lat/lon grid and go east first, +!> then to the west end of the next row north and end in the northeast corner. +!> The other info is in 'dirname/header.rst' +!> +!> 2. The name of the output file to store the netCDF variables +!> (netcdf_output_file) +!> +!> In the process, the routine will find: +!> +!> 1. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. +!> (nBlocksLon, nBlocksLat, 1) +!> +!> 2. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) +!> +!> 3. The number of lon/lats in a single grid block (nxPerBlock, +!> nyPerBlock, nzPerBlock) +!> +!> 4. The number of neutral species (and probably a mapping between +!> the species number and the variable name) (nSpeciesTotal, nSpecies) +!> +!> 5. The number of ion species (ditto - numbers <-> names) (nIons) +!> +!> We assume that the 'UseTopography' flag is false - that all columns +!> have the same altitude arrays. This is true on earth but not on +!> other planets. +!> +!> In addition to reading in the state data, it fills Longitude, +!> Latitude, and Altitude arrays with the grid spacing. This grid +!> is orthogonal and rectangular but can have irregular spacing along +!> any or all of the three dimensions. -end subroutine get_grid_from_netcdf +subroutine restart_files_to_netcdf(restart_dirname, member, netcdf_output_file) -!================================================================= +character(len=*), intent(in) :: restart_dirname +character(len=*), intent(in) :: netcdf_output_file +integer, intent(in) :: member -subroutine static_init_blocks(restart_dirname) +integer :: ncid -character(len=*), intent(in) :: restart_dirname -character(len=128) :: aether_filename +character(len=*), parameter :: routine = 'restart_files_to_netcdf' -character(len=*), parameter :: routine = 'static_init_blocks' +if (module_initialized ) then + write(string1,*)'The aether static_init_model was already initialized but ',trim(routine),& + ' uses a separate initialization procedure' + call error_handler(E_ERR,routine,string1,source,revision,revdate) +end if -character(len=NF90_MAX_NAME) :: varname -integer :: iunit, io, ivar -!logical :: has_gitm_namelist +call static_init_blocks(restart_dirname) -if (module_initialized) return ! only need to do this once +ncid = nc_create_file(netcdf_output_file) -! This prevents subroutines called from here from calling static_init_mod. -module_initialized = .true. +! DONE: This should probably be replaced by nc_write_model_atts(ncid). +! That may require renaming some dimension variables. +! call add_nc_definitions(ncid) +! Enters and exits define mode; +call nc_write_model_atts(ncid, 0) -! Read the namelist entry for model_mod from input.nml -call read_model_namelist() +call get_data(restart_dirname, ncid, member, define=.true.) -! error-check, convert namelist input to variable_table, and build the state structure -call make_variable_table() +! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts +! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying +! the state vector field names and source. +! call add_nc_dimvars(ncid) -! 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) +call get_data(restart_dirname, ncid, member, define=.false.) -! TODO: Reading aether_to_dart_nml is done only in aether_to_dart? -! filter_io_dir from here instead of redundant entry in model_mod_nml? -! ! Read the DART namelist for this model -! call find_namelist_in_file('input.nml', 'aether_to_dart_nml', iunit) -! read(iunit, nml = aether_to_dart_nml, iostat = io) -! call check_namelist_read(iunit, io, 'aether_to_dart_nml') -! -! ! Record the namelist values used for the run -! if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) -! if (do_nml_term()) write( * , nml=aether_to_dart_nml) +! TODO: this needs to be updated to write to which file? +! call write_model_time(ncid, state_time) -!--------------------------------------------------------------- -! Set the time step ... causes gitm namelists to be read. -! Ensures model_advance_time is multiple of 'dynamics_timestep' +call nc_close_file(ncid) -!TODO: Aether uses Julian time internally -! andor a Julian calendar (days from the start of the calendar), depending on the context) -call set_calendar_type( calendar ) ! comes from model_mod_nml +end subroutine restart_files_to_netcdf -!--------------------------------------------------------------- -! 1) get grid dimensions -! 2) allocate space for the grids -! 3) read them from the block restart files, could be stretched ... +!================================================================= -call get_grid_info_from_blocks(restart_dirname, nlon, nlat, nalt, nBlocksLon, & - nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) -print*,'static_init_blocks: post-get_grid_info_from_blocks; nfields_neutral = ', nfields_neutral +function get_model_size() +! Returns the size of the model as an integer. -if( debug > 0 ) then - write(string1,*) 'grid dims are ',nlon,nlat,nalt - call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif +integer(i8) :: get_model_size -! Opens and closes the grid block file, but not the filter netcdf file. -call get_grid_from_blocks(restart_dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & - nxPerBlock, nyPerBlock, nzPerBlock, lons, lats, alts ) +if ( .not. module_initialized ) call static_init_model -! Convert the Aether reference date (not calendar day = 0 date) -! to the days and seconds of the calendar set in model_mod_nml. -aeth_ref_time = set_date(aeth_ref_date(1), aeth_ref_date(2), aeth_ref_date(3), & - aeth_ref_date(4), aeth_ref_date(5)) -call get_time(aeth_ref_time,aeth_ref_nsecs,aeth_ref_ndays) +get_model_size = model_size -! Get the model time from a restart file. -aether_filename = block_file_name(variable_table(1,VT_ORIGININDX), 0, 0) -state_time = read_model_time(trim(restart_dirname)//'/'//trim(aether_filename)) +end function get_model_size -! TODO: Replace with aether variables check? (OR is that done when trying to read them?) -! call verify_block_variables( gitm_block_variables, nfields ) +!================================================================== +! TODO; will be provided by Ben's model_mod. ! -! do ivar = 1, nfields + subroutine model_interpolate(state_handle, ens_size, location, iqty, obs_val, istatus) + ! Given a location, and a model state variable qty, + ! interpolates the state variable field to that location. + ! obs_val is the interpolated value for each ensemble member + ! istatus is the success (0) or failure of the interpolation + + type(ensemble_type), intent(in) :: state_handle + integer, intent(in) :: ens_size + type(location_type), intent(in) :: location + integer, intent(in) :: iqty + real(r8), intent(out) :: obs_val(ens_size) !< array of interpolated values + integer, intent(out) :: istatus(ens_size) + + integer :: which_vert + integer :: lat_below, lat_above, lon_below, lon_above ! these are indices + real(r8) :: lon_fract, lat_fract + real(r8) :: lon, lat, lon_lat_lev(3) + real(r8), dimension(ens_size) :: val11, val12, val21, val22 + real(r8) :: height + integer :: level, bogus_level + integer :: dom_id, var_id ! -! varname = trim(gitm_block_variables(ivar)) -! gitmvar(ivar)%varname = varname +! if ( .not. module_initialized ) call static_init_model ! -! ! This routine also checks to make sure user specified accurate GITM variables -! call decode_gitm_indices( varname, & -! gitmvar(ivar)%gitm_varname, & -! gitmvar(ivar)%gitm_dim, & -! gitmvar(ivar)%gitm_index, & -! gitmvar(ivar)%long_name, & -! gitmvar(ivar)%units) -! if ( debug > 0 ) then -! call print_gitmvar_info(ivar,routine) -! endif -! enddo - -if ( debug > 0 ) then - write(string1,'("grid: nlon, nlat, nalt =",3(1x,i5))') nlon, nlat, nalt - call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif - -end subroutine static_init_blocks - -!================================================================== - -subroutine read_model_namelist() - -integer :: iunit, io - -! 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') - -! 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) - -end subroutine read_model_namelist - -!================================================================== - -!> Read the grid dimensions from a restart netcdf file. -!> -!> The file name comes from module storage ... namelist. - -subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, & - nalt, nBlocksLon, nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) - -character(len=*), intent(in) :: restart_dirname -integer, intent(out) :: nlon ! Number of Longitude centers -integer, intent(out) :: nlat ! Number of Latitude centers -integer, intent(out) :: nalt ! Number of Vertical grid centers -integer, intent(out) :: nBlocksLon, nBlocksLat, nBlocksAlt -real(r8), intent(out) :: LatStart, LatEnd, LonStart - -! TODO: get the grid info from a namelists (98 variables), instead of GITM's UAM.in. -! Then remove functions read_in_*. -! The rest of the UAM.in contents are for running GITM. -! Can wait until aether_to_dart push is done. -character(len=*), parameter :: filename = 'UAM.in' - -character(len=100) :: cLine ! iCharLen_ == 100 -character(len=256) :: fileloc +! ! Default for failure return +! istatus(:) = 1 +! obs_val(:) = MISSING_R8 +! +! ! Failure codes +! ! 11 QTY_GEOPOTENTIAL_HEIGHT is unsupported +! ! 22 unsupported veritcal coordinate +! ! 33 level given < or > model levels +! ! 44 quantity not part of the state +! ! 55 outside state (can not extrapolate above or below) +! ! 66 unknown vertical stagger +! +! ! GITM uses a vtec routine in obs_def_upper_atm_mod:get_expected_gnd_gps_vtec() +! ! TIEGCM has its own vtec routine, so we should use it. This next block ensures that. +! ! The get_expected_gnd_gps_vtec() tries to interpolate QTY_GEOPOTENTIAL_HEIGHT +! ! when it does, this will kill it. +! +! if ( iqty == QTY_GEOPOTENTIAL_HEIGHT ) then +! istatus(:) = 11 +! write(string1,*)'QTY_GEOPOTENTIAL_HEIGHT currently unsupported' +! call error_handler(E_ERR,'model_interpolate',string1,source, revision, revdate) +! endif +! +! +! ! Get the position +! lon_lat_lev = get_location(location) +! lon = lon_lat_lev(1) ! degree +! lat = lon_lat_lev(2) ! degree +! height = lon_lat_lev(3) ! level (int) or height (real) +! level = int(lon_lat_lev(3)) +! +! +! which_vert = nint(query_location(location)) +! +! call compute_bracketing_lat_indices(lat, lat_below, lat_above, lat_fract) +! call compute_bracketing_lon_indices(lon, lon_below, lon_above, lon_fract) +! +! ! Pressure is not part of the state vector +! ! pressure is static data on plevs/pilevs +! if ( iqty == QTY_PRESSURE) then +! if (which_vert == VERTISLEVEL) then +! ! @todo from Lanai code: +! ! Some variables need plevs, some need pilevs +! ! We only need the height (aka level) +! ! the obs_def_upper_atm_mod.f90:get_expected_O_N2_ratio routines queries +! ! for the pressure at the model levels - EXACTLY - so ... +! ! FIXME ... at present ... the only time model_interpolate +! ! gets called with QTY_PRESSURE is to calculate density, which +! ! requires other variables that only live on the midpoints. +! ! I cannot figure out how to generically decide when to +! ! use plevs vs. pilevs +! +! ! Check to make sure vertical level is possible. +! if ((level < 1) .or. (level > nalt)) then +! istatus(:) = 33 +! return +! else +! obs_val(:) = plevs(level) +! istatus(:) = 0 +! endif +! elseif (which_vert == VERTISHEIGHT) then +! +! ! @todo from Lanai code: +! ! FIXME ... is it possible to try to get a pressure with which_vert == undefined +! ! At present, vert_interp will simply fail because height is a negative number. +! ! @todo HK what are you supposed to do for pressure with VERTISUNDEF? level 1? +! +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) +! if (any(istatus /= 0)) return ! bail at the first failure +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) +! if (any(istatus /= 0)) return +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) +! if (any(istatus /= 0)) return +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! else +! +! write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' +! call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) +! +! endif ! which vert +! +! return +! +! endif ! end of QTY_PRESSURE +! +! +! if ( iqty == QTY_VERTICAL_TEC ) then ! extrapolate vtec +! +! call extrapolate_vtec(state_handle, ens_size, lon_below, lat_below, val11) +! call extrapolate_vtec(state_handle, ens_size, lon_below, lat_above, val11) +! call extrapolate_vtec(state_handle, ens_size, lon_above, lat_below, val11) +! call extrapolate_vtec(state_handle, ens_size, lon_above, lat_above, val11) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! istatus(:) = 0 +! +! return +! endif +! +! ! check if qty is in the state vector +! call find_qty_in_state(iqty, dom_id, var_id) +! if (dom_id < 0 ) then +! istatus(:) = 44 +! return +! endif +! +! if( which_vert == VERTISHEIGHT ) then +! +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) +! if (any(istatus /= 0)) return ! bail at the first failure +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) +! if (any(istatus /= 0)) return +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) +! if (any(istatus /= 0)) return +! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! istatus = 0 +! elseif( which_vert == VERTISLEVEL) then +! ! Check to make sure vertical level is possible. +! if ((level < 1) .or. (level > nilev)) then +! istatus(:) = 33 +! return +! endif +! +! ! one use of model_interpolate is to allow other modules/routines +! ! the ability to 'count' the model levels. To do this, create observations +! ! with locations on model levels and 'interpolate' for QTY_GEOMETRIC_HEIGHT. +! ! When the interpolation fails, you've gone one level too far. +! ! HK why does it have to be QTY_GEOMETRIC_HEIGHT? +! +! val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, level, domain_id(dom_id), var_id ), state_handle) +! val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, level, domain_id(dom_id), var_id ), state_handle) +! val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, level, domain_id(dom_id), var_id ), state_handle) +! val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, level, domain_id(dom_id), var_id ), state_handle) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! istatus = 0 +! +! elseif( which_vert == VERTISUNDEF) then +! bogus_level = 1 !HK what should this be? Do only 2D fields have VERTISUNDEF? +! val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) +! val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) +! val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) +! val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) +! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) +! istatus(:) = 0 +! +! else +! +! write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' +! call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) +! +! endif +! + end subroutine model_interpolate -integer :: i, iunit, ios +!------------------------------------------------------------------------------- +function shortest_time_between_assimilations() +type(time_type) :: shortest_time_between_assimilations -character(len=*), parameter :: routine = 'get_grid_info_from_blocks' +shortest_time_between_assimilations = time_step -! get the ball rolling ... +end function shortest_time_between_assimilations -nBlocksLon = 0 -nBlocksLat = 0 -nBlocksAlt = 0 -LatStart = 0.0_r8 -LatEnd = 0.0_r8 -LonStart = 0.0_r8 +!================================================================== +! + subroutine get_state_meta_data(index_in, location, var_qty) + ! Given an integer index into the state vector, returns the + ! associated location and optionally the variable quantity. + + integer(i8), intent(in) :: index_in + type(location_type), intent(out) :: location + integer, optional, intent(out) :: var_qty + + integer :: lon_index, lat_index, lev_index + integer :: local_qty, var_id, dom_id + integer :: seconds, days ! for f10.7 location + real(r8) :: longitude ! for f10.7 location + character(len=NF90_MAX_NAME) :: dim_name + +! if ( .not. module_initialized ) call static_init_model +! +! call get_model_variable_indices(index_in, lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id, kind_index=local_qty) +! +! if(present(var_qty)) var_qty = local_qty +! +! if (get_variable_name(dom_id, var_id) == 'f10_7') then +! ! f10_7 is most accurately located at local noon at equator. +! ! 360.0 degrees in 86400 seconds, 43200 secs == 12:00 UTC == longitude 0.0 +! +! call get_time(state_time, seconds, days) +! longitude = 360.0_r8 * real(seconds,r8) / 86400.0_r8 - 180.0_r8 +! if (longitude < 0.0_r8) longitude = longitude + 360.0_r8 +! location = set_location(longitude, 0.0_r8, 400000.0_r8, VERTISUNDEF) +! return +! end if +! +! ! search for either ilev or lev +! dim_name = ilev_or_lev(dom_id, var_id) +! +! select case (trim(dim_name)) +! case ('ilev') +! location = set_location(lons(lon_index), lats(lat_index), ilevs(lev_index), VERTISLEVEL) +! case (ALT_DIM_NAME) +! location = set_location(lons(lon_index), lats(lat_index), alts(lev_index), VERTISLEVEL) +! case default +! call error_handler(E_ERR, 'get_state_meta_data', 'expecting ilev or ilat dimension') +! ! HK @todo 2D variables. +! end select +! + end subroutine get_state_meta_data + +!================================================================== -write(fileloc,'(a,''/'',a)') trim(restart_dirname),trim(filename) +subroutine end_model() +! Does any shutdown and clean-up needed for model. -if (debug > 4) then - write(string1,*) 'Now opening Aether UAM file: ',trim(fileloc) - call error_handler(E_MSG,routine,string1,source,revision,revdate) -end if +end subroutine end_model +!================================================================== -iunit = open_file(trim(fileloc), action='read') +! Writes the model-specific attributes to a netCDF file. +subroutine nc_write_model_atts( ncid, dom_id) -UAMREAD : do i = 1, 1000000 +integer, intent(in) :: ncid ! netCDF file identifier +integer, intent(in) :: dom_id - read(iunit,'(a)',iostat=ios) cLine +real(r8), allocatable :: temp_lons(:) +character(len=*), parameter :: routine = 'nc_write_model_atts' - if (ios /= 0) then - ! If we get to the end of the file or hit a read error without - ! finding what we need, die. - write(string1,*) 'cannot find #GRID in ',trim(fileloc) - call error_handler(E_ERR,'get_grid_info_from_blocks',string1,source,revision,revdate) - endif +if ( .not. module_initialized ) call static_init_model - if (cLine(1:5) .ne. "#GRID") cycle UAMREAD +! Write Global Attributes - nBlocksLon = read_in_int( iunit,'NBlocksLon',trim(fileloc)) - nBlocksLat = read_in_int( iunit,'NBlocksLat',trim(fileloc)) - nBlocksAlt = read_in_int( iunit,'NBlocksAlt',trim(fileloc)) - LatStart = read_in_real(iunit,'LatStart', trim(fileloc)) - LatEnd = read_in_real(iunit,'LatEnd', trim(fileloc)) - LonStart = read_in_real(iunit,'LonStart', trim(fileloc)) +call nc_add_global_creation_time(ncid, routine) - exit UAMREAD +call nc_add_global_attribute(ncid, "model_source", source, routine) +call nc_add_global_attribute(ncid, "model", "Aether", routine) -enddo UAMREAD -if (debug > 4) then - write(string1,*) 'Successfully read Aether UAM grid file:',trim(fileloc) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nBlocksLon:',nBlocksLon - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nBlocksLat:',nBlocksLat - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nBlocksAlt:',nBlocksAlt - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' LatStart:',LatStart - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' LatEnd:',LatEnd - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' LonStart:',LonStart - call error_handler(E_MSG,routine,string1,source,revision,revdate) -end if +! define grid dimensions +call nc_define_dimension(ncid, LON_DIM_NAME, nlon, routine) +call nc_define_dimension(ncid, LAT_DIM_NAME, nlat, routine) +call nc_define_dimension(ncid, ALT_DIM_NAME, nalt, routine) +call nc_define_dimension(ncid, 'ilev', nilev, routine) -call close_file(iunit) +! define grid variables +! longitude +call nc_define_real_variable( ncid, LON_DIM_NAME, (/ LON_DIM_NAME /), routine) +call nc_add_attribute_to_variable(ncid, LON_DIM_NAME, 'long_name', 'geographic longitude (-west, +east)', routine) +call nc_add_attribute_to_variable(ncid, LON_DIM_NAME, 'units', 'degrees_east', routine) -end subroutine get_grid_info_from_blocks +! latitude +call nc_define_real_variable( ncid, LAT_DIM_NAME, (/ LAT_DIM_NAME /), routine) +call nc_add_attribute_to_variable(ncid, LAT_DIM_NAME, 'long_name', 'geographic latitude (-south, +north)', routine) +call nc_add_attribute_to_variable(ncid, LAT_DIM_NAME, 'units', 'degrees_north', routine) -!================================================================== +! alts +call nc_define_real_variable( ncid, ALT_DIM_NAME, (/ ALT_DIM_NAME /), routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'long_name', 'midpoint altitudes', routine) +! DONE: vert coord is altitude, not ... +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'short name', 'altitude', routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'positive', 'up', routine) +call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'standard_name', 'unknown', routine) +! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula_terms', 'p0: p0 lev: lev', routine) +! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-lev(k))', routine) -function read_in_int(iunit,varname,filename) -integer, intent(in) :: iunit -character(len=*), intent(in) :: varname,filename -integer :: read_in_int +! ilevs +! call nc_define_real_variable( ncid, 'ilev', (/ 'ilev' /), routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'long_name', 'interface levels', routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'short name', 'ln(p0/p)', routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'positive', 'up', routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) +! call nc_add_attribute_to_variable(ncid, 'ilev', 'formula_terms', 'p0: p0 lev: ilev', routine) +! ! TODO: Is there an interface alt? +! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-ilev(k))', routine) -character(len=100) :: cLine -integer :: i, ios -! Read a line -read(iunit,'(a)',iostat=ios) cLine -if (ios /= 0) then - write(string1,*) 'cannot find '//trim(varname)//' in '//trim(filename) - call error_handler(E_ERR,'get_grid_dims',string1,source,revision,revdate) -endif +call nc_end_define_mode(ncid, routine) -! Remove anything after a space or TAB -i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' -i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' +!------------------------------------------------------------------------------- +! Write variables +!------------------------------------------------------------------------------- -read(cLine,*,iostat=ios)read_in_int +! TODO: Should nc_write_model_atts write dimension contents, not just atts? +! Gitm had a separate routine for filling the dimensions: +! - - - - - - - - - - - +! subroutine add_nc_dimvars(ncid) +! +! integer, intent(in) :: ncid +! +! !---------------------------------------------------------------------------- +! ! Fill the coordinate variables +! !---------------------------------------------------------------------------- +! +! call nc_put_variable(ncid, LON_VAR_NAME, lons) +! call nc_put_variable(ncid, LAT_VAR_NAME, lats) +! call nc_put_variable(ncid, ALT_VAR_NAME, alts) +! ! what about WL? +! +! !if (has_gitm_namelist) then +! ! call file_to_text('gitm_vars.nml', textblock) +! ! call nc_put_variable(ncid, 'gitm_in', textblock) +! ! deallocate(textblock) +! !endif +! +! !------------------------------------------------------------------------------- +! ! Flush the buffer and leave netCDF file open +! !------------------------------------------------------------------------------- +! call nc_synchronize_file(ncid) +! +! end subroutine add_nc_dimvars +! - - - - - - - - - - - -if(ios /= 0) then - write(string1,*)'unable to read '//trim(varname)//' in '//trim(filename) - call error_handler(E_ERR,'read_in_int',string1,source,revision,revdate,& - text2=cLine) -endif -end function read_in_int +! Fill in the coordinate variables -!================================================================= +! longitude - Aether uses values +/- pi, but lons has been converted already. +! DART uses values [0,360] +allocate(temp_lons(nlon)) +temp_lons = lons +where (temp_lons < 0.0_r8) temp_lons = temp_lons + 360.0_r8 +! where (temp_lons >= 180.0_r8) temp_lons = temp_lons - 360.0_r8 +call nc_put_variable(ncid, LON_VAR_NAME, temp_lons, routine) +call nc_put_variable(ncid, LAT_VAR_NAME, lats, routine) +call nc_put_variable(ncid, ALT_VAR_NAME, alts, routine) +! call nc_put_variable(ncid, 'ilev', ilevs, routine) +deallocate(temp_lons) -function read_in_real(iunit,varname,filename) +! flush any pending i/o to disk +call nc_synchronize_file(ncid, routine) -integer, intent(in) :: iunit -character(len=*), intent(in) :: varname,filename -real(r8) :: read_in_real +end subroutine nc_write_model_atts -character(len=100) :: cLine -integer :: i, ios +!================================================================== -! Read a line -read(iunit,'(a)',iostat=ios) cLine -if (ios /= 0) then - write(string1,*) 'cannot find '//trim(varname)//' in '//trim(filename) - call error_handler(E_ERR,'get_grid_dims',string1,source,revision,revdate) -endif +! TODO: this will be replaced by Ben. +! Vertical localization is done only in height (ZG). +! obs vertical location is given in height (model_interpolate). +! state vertical location is given in height. +subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & + num_close, close_ind, dist, state_handle) -! Remove anything after a space or TAB -i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' -i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' +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) :: state_handle -! Now that we have a line with nothing else ... parse it -read(cLine,*,iostat=ios)read_in_real +integer :: k, q_ind +integer :: n +integer :: istatus -if(ios /= 0) then - write(string1,*)'unable to read '//trim(varname)//' in '//trim(filename) - call error_handler(E_ERR,'read_in_real',string1,source,revision,revdate) -endif +! n = size(locs) +! +! if (vertical_localization_on()) then ! need to get height +! call convert_vertical_state(state_handle, n, locs, loc_qtys, loc_indx, VERTISHEIGHT, istatus) ! HK Do we care about istatus? +! endif +! +! call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & +! num_close, close_ind, dist) +! +! ! Make the ZG part of the state vector far from everything so it does not get updated. +! ! HK Note if you have inflation on ZG has been inflated. +! ! Scroll through all the obs_loc(:) and obs_kind(:) elements +! +! do k = 1,num_close +! q_ind = close_ind(k) +! if (loc_qtys(q_ind) == QTY_GEOMETRIC_HEIGHT) then +! if (do_output() .and. (debug > 99)) then +! write( * ,*)'get_close_state ZG distance is ', & +! dist(k),' changing to ',10.0_r8 * PI +! write(logfileunit,*)'get_close_state ZG distance is ', & +! dist(k),' changing to ',10.0_r8 * PI +! endif +! dist(k) = 10.0_r8 * PI +! endif +! enddo +! +! +! if (estimate_f10_7) then +! ! f10_7 is given a location of latitude 0.0 and the longitude +! ! of local noon. By decreasing the distance from the observation +! ! to the dynamic f10_7 location we are allowing the already close +! ! observations to have a larger impact in the parameter estimation. +! ! 0.25 is heuristic. The 'close' observations have already been +! ! determined by the cutoff. Changing the distance here does not +! ! allow more observations to impact anything. +! do k = 1, num_close +! q_ind = close_ind(k) +! if (loc_qtys(q_ind) == QTY_1D_PARAMETER) then +! dist(k) = dist(k)*0.25_r8 +! endif +! enddo +! endif +! +! +end subroutine get_close_state -end function read_in_real +!================================================================== -!================================================================= +subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, & + which_vert, istatus) -! open enough of the restart files to read in the lon, lat, alt arrays +type(ensemble_type), intent(in) :: state_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) :: istatus(:) -subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & - nxPerBlock, nyPerBlock, nzPerBlock, & - lons, lats, alts ) +integer :: current_vert_type, i +real(r8) :: height(1) +integer :: local_status(1) -character(len=*), intent(in) :: dirname -integer, intent(in) :: nBlocksLon ! Number of Longitude blocks -integer, intent(in) :: nBlocksLat ! Number of Latitude blocks -integer, intent(in) :: nBlocksAlt ! Number of Altitude blocks -integer, intent(out) :: nxPerBlock ! Number of non-halo Longitude centers per block -integer, intent(out) :: nyPerBlock ! Number of non-halo Latitude centers per block -integer, intent(out) :: nzPerBlock ! Number of Vertical grid centers +character(len=*), parameter :: routine = 'convert_vertical_obs' -real(r8), allocatable , dimension( : ), intent(inout) :: lons, lats, alts +! if ( which_vert == VERTISHEIGHT .or. which_vert == VERTISUNDEF) then +! istatus(:) = 0 +! return +! endif +! +! do i = 1, num +! current_vert_type = nint(query_location(locs(i))) +! if (( current_vert_type == which_vert ) .or. & +! ( current_vert_type == VERTISUNDEF)) then +! istatus(i) = 0 +! cycle +! endif +! +! call model_interpolate(state_handle, 1, locs(i), QTY_GEOMETRIC_HEIGHT, height, local_status ) +! +! if (local_status(1) == 0) call set_vertical(locs(i), height(1), VERTISHEIGHT) +! istatus(i) = local_status(1) +! +! enddo +! +end subroutine convert_vertical_obs -integer :: ios, nb, offset, ncid, nboff -character(len=128) :: filename -real(r4), allocatable :: temp(:,:,:) -integer :: starts(3),ends(3), xcount, ycount, zcount +!================================================================== + 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 + + integer :: var_id, dom_id, lon_index, lat_index, lev_index + integer :: i + real(r8) :: height(1), height1(1), height2(1) + character(len=NF90_MAX_NAME) :: dim_name + integer(i8) :: height_idx + + +! if ( which_vert /= VERTISHEIGHT ) then +! call error_handler(E_ERR,'convert_vertical_state', 'only supports VERTISHEIGHT') +! endif +! +! istatus = 0 !HK what are you doing with this? +! +! do i = 1, num +! +! call get_model_variable_indices(loc_indx(i), lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id) +! +! ! search for either ilev or lev +! dim_name = ilev_or_lev(dom_id, var_id) +! +! select case (trim(dim_name)) +! case ('ilev') +! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & +! domain_id(SECONDARY_DOM), ivarZG) +! height = get_state(height_idx, state_handle)/100.0_r8 +! +! case (ALT_DIM_NAME) ! height on midpoint +! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & +! domain_id(SECONDARY_DOM), ivarZG) +! height1 = get_state(height_idx, state_handle)/100.0_r8 +! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index+1, & +! domain_id(SECONDARY_DOM), ivarZG) +! height2 = get_state(height_idx, state_handle)/100.0_r8 +! height = (height1 + height2) / 2.0_r8 +! +! case default +! call error_handler(E_ERR, 'convert_vertical_state', 'expecting ilev or ilat dimension') +! end select +! +! locs(i) = set_location(lons(lon_index), lats(lat_index), height(1), VERTISHEIGHT) +! +! end do +! +end subroutine convert_vertical_state -character(len=*), parameter :: routine = 'get_grid_from_blocks' +!================================================================== -! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), -! in order to calculate the n[xyz]PerBlock dimensions. -! grid_g0000.nc looks like a worthy candidate, but a restart could be used. -write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' -ncid = nc_open_file_readonly(filename, routine) +function read_model_time(filename) +type(time_type) :: read_model_time +character(len=*), intent(in) :: filename -! The grid (and restart) file variables have halos, so strip them off -! to get the number of actual data values in each dimension of the block. -nxPerBlock = nc_get_dimension_size(ncid, 'x', routine) - 2*nGhost -nyPerBlock = nc_get_dimension_size(ncid, 'y', routine) - 2*nGhost -nzPerBlock = nc_get_dimension_size(ncid, 'z', routine) +integer :: ncid, i, ios +integer :: tsimulation ! the time read from a restart file; seconds from aeth_ref_date. +integer :: ndays,nsecs -nlon = nBlocksLon * nxPerBlock -nlat = nBlocksLat * nyPerBlock -nalt = nBlocksAlt * nzPerBlock +character(len=*), parameter :: routine = 'read_model_time' -write(string1,*) 'nlon = ', nlon -call error_handler(E_MSG,routine,string1,source,revision,revdate) -write(string1,*) 'nlat = ', nlat -call error_handler(E_MSG,routine,string1,source,revision,revdate) -write(string1,*) 'nalt = ', nalt -call error_handler(E_MSG,routine,string1,source,revision,revdate) +tsimulation = MISSING_I -! This is also done in gitm's static_init_model, which is not called by aether_to_dart, -! so it's not redundant. -allocate( lons( nlon )) -allocate( lats( nlat )) -allocate( alts( nalt )) +ncid = open_block_file(filename, 'read') +call nc_get_variable(ncid, 'time', tsimulation, routine) +call nc_close_file(ncid, routine, filename) -if (debug > 4) then - write(string1,*) 'Successfully read GITM grid file:',trim(filename) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nxPerBlock:',nxPerBlock +! Calculate the DART time of the file time. +! TODO: review calculation of ndays in read_model_time +ndays = tsimulation/86400 +nsecs = tsimulation - ndays*86400 +! Need to subtract 1 because the ref day is not finished. +ndays = aeth_ref_ndays -1 + ndays +read_model_time = set_time(nsecs,ndays) + +if (do_output()) & + call print_time(read_model_time,'read_model_time: time in restart file '//filename) +if (do_output()) & + call print_date(read_model_time,'read_model_time: date in restart file '//filename) + +if (debug > 8) then + write(string1,*)'tsimulation ',tsimulation call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nyPerBlock:',nyPerBlock + write(string1,*)'ndays ',ndays call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nzPerBlock:',nzPerBlock + write(string1,*)'nsecs ',nsecs call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif - -! A temp array large enough to hold any of the 3D -! Lon,Lat or Alt arrays from a block plus ghost cells. -! The restart files have C-indexing (fastest changing dim is the last). -allocate(temp( 1:nzPerBlock, & - 1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost)) -temp = -888888. -print*,'shape of temp = ',shape(temp) + call print_date( aeth_ref_time, 'read_model_time:model base date') + call print_time( aeth_ref_time, 'read_model_time:model base time') +endif -starts(1) = 1-nGhost -starts(2) = 1-nGhost -starts(3) = 1 -ends(1) = nxPerBlock+nGhost -ends(2) = nyPerBlock+nGhost -ends(3) = nzPerBlock -xcount = nxPerBlock + 2*nGhost -ycount = nyPerBlock + 2*nGhost -zcount = nzPerBlock -print*,'starts = ',starts -print*,'ends = ',ends -print*,'counts = ',xcount,ycount,zcount +end function read_model_time -! go across the south-most block row picking up all longitudes -do nb = 1, nBlocksLon - filename = block_file_name('grid', -1, nb-1) - ncid = open_block_file(trim(filename), 'read') +!=============================================================================== +! Routines below here are private to the module +!=============================================================================== -! Read 3D array and extract the longitudes of the non-halo data of this block. -! This gets nc_get_double_3d, even though the fields are float. -!? Is there some environment setting that says float = double? -! ERROR This yields Start+count exceeds dimension bound -! call nc_get_variable(ncid, 'Longitude', temp, routine) -! ERROR: this yields Index exceeds dimension bound -! The restart files have C-indexing (fastest changing dim is the last), -! So invert the dimension bounds. - call nc_get_variable(ncid, 'Longitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - routine, & - nc_count=(/zcount,ycount,xcount/)) -! Shouldn't need to specify default values nc_start=(/1,1,1/), & +! Fill up the variable_table from the namelist item 'variables' +! The namelist item variables is where a user specifies +! which variables they want in the DART state: +! variable name, dart qty, clamping min, clamping max, origin file, update or not -! temp(1:zcount,1:ycount,1:xcount), & -! nc_start=(/starts(1),starts(2),starts(3)/), & -! TODO: nc_get_variable stops on error conditions, does not pass back ios. -! if ( ios /= 0 ) then -! print *,'size:',size(temp(1-nGhost:nxPerBlock+nGhost)) -! print *,'IO error code:',ios -! write(string1,*)'ERROR reading file ', trim(filename) -! write(string2,*)'longitude block ',nb,' of ',nBlocksLon -! call error_handler(E_ERR,'get_grid',string1, & -! source,revision,revdate,text2=string2) -! endif +subroutine make_variable_table() - offset = (nxPerBlock * (nb - 1)) - lons(offset+1:offset+nxPerBlock) = temp(1,1,1:nxPerBlock) +integer :: nfields_constructed ! number of constructed state variables - call nc_close_file(ncid) -enddo +integer :: i, nrows, ncols -! go up west-most block row picking up all latitudes -do nb = 1, nBlocksLat +character(len=NF90_MAX_NAME) :: varname +character(len=NF90_MAX_NAME) :: dartstr +character(len=NF90_MAX_NAME) :: minvalstring +character(len=NF90_MAX_NAME) :: maxvalstring +character(len=NF90_MAX_NAME) :: filename +character(len=NF90_MAX_NAME) :: state_or_aux - ! TODO; Aether block name counters start with 0, but the lat values can come from - ! any lon=const column. - nboff = ((nb - 1) * nBlocksLon) - filename = block_file_name('grid', -1, nboff) - ncid = open_block_file(trim(filename), 'read') +nrows = size(variable_table,1) ! these are MAX_NUM_VARIABLES, MAX_NUM_COLUMNS +ncols = size(variable_table,2) - call nc_get_variable(ncid, 'Latitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - routine, nc_count=(/zcount,ycount,xcount/)) - -! if ( ios /= 0 ) then -! write(string1,*)'ERROR reading file ', trim(filename) -! write(string2,*)'latitude block ',nb,' of ',nBlocksLat -! call error_handler(E_ERR,'get_grid',string1, & -! source,revision,revdate,text2=string2) -! endif +! Convert the (input) 1D array "variables" into a table with six columns. +! The number of rows in the table correspond to the number of variables in the +! DART state vector. +! Column 1 is the netCDF variable name. +! Column 2 is the corresponding DART kind. +! Column 3 is the minimum value ("NA" if there is none) Not Applicable +! Column 4 is the maximum value ("NA" if there is none) Not Applicable +! Column 5 is the file of origin aether restart 'neutrals' or 'ions' +! Column 6 is whether or not the variable should be updated in the restart file. - offset = (nyPerBlock * (nb - 1)) - lats(offset+1:offset+nyPerBlock) = temp(1,1:nyPerBlock,1) +nfields = 0 +! TODO: TIEGCM uses 3 domains. Aether may need only 1: +! Do we need the 3rd category for derived fields; TEC, ...? +nfields_neutral = 0 +nfields_ion = 0 +nfields_constructed = 0 - call nc_close_file(ncid) -enddo +ROWLOOP : do i = 1, nrows + varname = trim(variables(ncols*i - 5)) + dartstr = trim(variables(ncols*i - 4)) + minvalstring = trim(variables(ncols*i - 3)) + maxvalstring = trim(variables(ncols*i - 2)) + filename = trim(variables(ncols*i - 1)) + state_or_aux = trim(variables(ncols*i )) -! this code assumes UseTopography is false - that all columns share -! the same altitude array, so we can read it from the first block. -! if this is not the case, this code has to change. +! TODO: should Aether use the 6th column of namelist variable input to handle TEC, ...? + call to_upper(state_or_aux) ! update or not -filename = block_file_name('grid', -1, 0) -ncid = open_block_file(trim(filename), 'read') + variable_table(i,VT_VARNAMEINDX) = trim(varname) + variable_table(i,VT_KINDINDX) = trim(dartstr) + variable_table(i,VT_MINVALINDX) = trim(minvalstring) + variable_table(i,VT_MAXVALINDX) = trim(maxvalstring) + variable_table(i,VT_ORIGININDX) = trim(filename) + variable_table(i,VT_STATEINDX) = trim(state_or_aux) -temp = MISSING_R8 -call nc_get_variable(ncid, 'Altitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - routine, nc_count=(/zcount,ycount,xcount/)) + ! If the first element is empty, we have found the end of the list. + if ((variable_table(i,1) == ' ') ) exit ROWLOOP -alts(1:nzPerBlock) = temp(1:nzPerBlock,1,1) -! print*,'temp = ',temp(:,1,1) -! print*,'alts = ',alts - -call nc_close_file(ncid) - -deallocate(temp) + ! Any other condition is an error. + if ( any(variable_table(i,:) == ' ') ) then + string1 = 'input.nml &model_nml:variables not fully specified.' + string2 = 'Must be 6 entries per variable, last known variable name is' + string3 = trim(variable_table(i,1)) + call error_handler(E_ERR,'get_variables_in_domain',string1, & + source,revision,revdate,text2=string2,text3=string3) + endif +! TODO; Modify this gitm error check for this routine? +! ! Make sure DART kind is valid +! +! 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 -! convert from radians into degrees -lons = lons * RAD2DEG -lats = lats * RAD2DEG + nfields=nfields+1 + if (trim(variable_table(i,VT_ORIGININDX)) == 'neutrals') then + nfields_neutral = nfields_neutral+1 + else if (trim(variable_table(i,VT_ORIGININDX)) == 'ions') then + nfields_ion = nfields_ion+1 + else if (trim(variable_table(i,VT_ORIGININDX)) == 'CALCULATE') then + nfields_constructed = nfields_constructed + 1 + else + print*,'variable_table(',i, VT_ORIGININDX,') = ', trim(variable_table(i,VT_ORIGININDX)) + endif + print*,'make_variable_table: nfields = ',nfields, nfields_neutral, nfields_ion -if (debug > 4) then - print *, 'All lons ', lons - print *, 'All lats ', lats - print *, 'All alts ', alts -endif +enddo ROWLOOP -if ( debug > 1 ) then ! Check dimension limits - write(string1,*)'LON range ',minval(lons),maxval(lons) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'LAT range ',minval(lats),maxval(lats) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'ALT range ',minval(alts),maxval(alts) - call error_handler(E_MSG,routine,string1,source,revision,revdate) +! Record the contents of the DART state vector +if (do_output() .and. (debug > 99)) then + do i = 1,nfields + write(*,'(''variable'',i4,'' is '',a12,1x,a32,4(1x,a20))') i, & + trim(variable_table(i,1)), & + trim(variable_table(i,2)), & + trim(variable_table(i,3)), & + trim(variable_table(i,4)), & + trim(variable_table(i,5)), & + trim(variable_table(i,6)) + write(logfileunit,'(''variable'',i4,'' is '',a12,1x,a32,4(1x,a20))') i, & + trim(variable_table(i,1)), & + trim(variable_table(i,2)), & + trim(variable_table(i,3)), & + trim(variable_table(i,4)), & + trim(variable_table(i,5)), & + trim(variable_table(i,6)) + enddo endif -end subroutine get_grid_from_blocks +! TODO: Aether may need something like this. +! if (estimate_f10_7) then +! if (nfields_constructed == 0) then +! call error_handler(E_ERR, 'expecting f10.7 in &model_nml::variables', source) +! endif +! call load_up_state_structure_from_file(f10_7_file_name, nfields_constructed, 'CALCULATE', CONSTRUCT_DOM) +! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) & +! + get_domain_size(CONSTRUCT_DOM) +! else +! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) +! endif +! +end subroutine make_variable_table !================================================================== -!> Create a filename from input file characteristics: -! filetype, member number, block number. -! filetype = {'grid','neutrals','ions', [...?]}. -! The first part of the name of the aether file to read. -! memnum or blocknum < 0 means don't include that part of the name. - -function block_file_name(filetype, memnum, blocknum) +! Read the lon, lat, and alt arrays from the ncid -character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} -! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? -! This code can handle it; a longer filetype passed in, and no member -! ? output files? -integer, intent(in) :: blocknum -integer, intent(in) :: memnum -character(len=128) :: block_file_name +subroutine get_grid_from_netcdf(filter_io_filename, lons, lats, alts ) -block_file_name = trim(filetype) -if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum -if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum -block_file_name = trim(block_file_name)//'.nc' -! TODO: Convert print to the error handler -print*,'filename, memnum, blocknum = ' ,trim(block_file_name), memnum, blocknum +character(len=*), intent(in) :: filter_io_filename +real(r8), intent(inout) :: lons(:) +real(r8), intent(inout) :: lats(:) +real(r8), intent(inout) :: alts(:) -end function block_file_name +character(len=*), parameter :: routine = 'get_grid_from_netcdf' -!================================================================== +integer :: ncid -!> open the requested restart file and return the ncid +ncid = nc_open_file_readonly(filter_io_filename, routine) -function open_block_file(filename,rw) +call nc_get_variable(ncid, LON_VAR_NAME, lons, routine) +call nc_get_variable(ncid, LAT_VAR_NAME, lats, routine) +call nc_get_variable(ncid, ALT_VAR_NAME, alts, routine) -character(len=*), intent(in) :: filename -character(len=*), intent(in) :: rw ! 'read' or 'readwrite' -integer :: open_block_file +call nc_close_file(ncid) -character(len=*), parameter :: routine = 'open_block_file' +end subroutine get_grid_from_netcdf -if ( rw == 'read' .and. .not. file_exist(trim(filename)) ) then - write(string1,*) 'cannot open file ', trim(filename),' for reading.' - call error_handler(E_ERR,'open_block_file',string1,source,revision,revdate) -endif +!================================================================= -if (debug > 0) then - write(string1,*) 'Opening file ', trim(filename), ' for ', trim(rw) - call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) -end if +subroutine static_init_blocks(restart_dirname) -open_block_file = nc_open_file_readonly(trim(filename), routine) +character(len=*), intent(in) :: restart_dirname +character(len=128) :: aether_filename -if (debug > 80) then - write(string1,*) 'Returned file descriptor is ', open_block_file - call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) -end if +character(len=*), parameter :: routine = 'static_init_blocks' -end function open_block_file +character(len=NF90_MAX_NAME) :: varname +integer :: iunit, io, ivar +!logical :: has_gitm_namelist -!================================================================= +if (module_initialized) return ! only need to do this once -subroutine verify_block_variables( variable_array, ngood) +! This prevents subroutines called from here from calling static_init_mod. +module_initialized = .true. -character(len=*), dimension(:), intent(in) :: variable_array -integer, intent(out) :: ngood +! Read the namelist entry for model_mod from input.nml +call read_model_namelist() -integer :: nrows, i -character(len=NF90_MAX_NAME) :: varname +! error-check, convert namelist input to variable_table, and build the state structure +call make_variable_table() -character(len=*), parameter :: routine = 'verify_state_variables' +! 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) -nrows = size(variable_array,1) +! TODO: Reading aether_to_dart_nml is done only in aether_to_dart? +! filter_io_dir from here instead of redundant entry in model_mod_nml? +! ! Read the DART namelist for this model +! call find_namelist_in_file('input.nml', 'aether_to_dart_nml', iunit) +! read(iunit, nml = aether_to_dart_nml, iostat = io) +! call check_namelist_read(iunit, io, 'aether_to_dart_nml') +! +! ! Record the namelist values used for the run +! if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) +! if (do_nml_term()) write( * , nml=aether_to_dart_nml) -ngood = 0 -MyLoop : do i = 1, nrows +!--------------------------------------------------------------- +! Set the time step ... causes gitm namelists to be read. +! Ensures model_advance_time is multiple of 'dynamics_timestep' - varname = variable_array(i) +!TODO: Aether uses Julian time internally +! andor a Julian calendar (days from the start of the calendar), depending on the context) +call set_calendar_type( calendar ) ! comes from model_mod_nml - if ( varname == ' ') exit MyLoop ! Found end of list. +!--------------------------------------------------------------- +! 1) get grid dimensions +! 2) allocate space for the grids +! 3) read them from the block restart files, could be stretched ... - ngood = ngood + 1 -enddo MyLoop +call get_grid_info_from_blocks(restart_dirname, nlon, nlat, nalt, nBlocksLon, & + nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) +print*,'static_init_blocks: post-get_grid_info_from_blocks; nfields_neutral = ', nfields_neutral -if (ngood == nrows) then - string1 = 'WARNING: There is a possibility you need to increase ''max_state_variables''' - write(string2,'(''WARNING: you have specified at least '',i4,'' perhaps more.'')')ngood - call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2) +if( debug > 0 ) then + write(string1,*) 'grid dims are ',nlon,nlat,nalt + call error_handler(E_MSG,routine,string1,source,revision,revdate) endif -end subroutine verify_block_variables - -!================================================================== -!> Converts Aether restart files to a netCDF file -!> Modified from models/gitm/model_mod.f90 -!> -!> This routine needs: -!> -!> 1. A base dirname for the restart files (restart_dirname). -!> they will have the format 'dirname/bNNNN.rst' where NNNN has -!> leading 0s and is the block number. Blocks start in the -!> southwest corner of the lat/lon grid and go east first, -!> then to the west end of the next row north and end in the northeast corner. -!> The other info is in 'dirname/header.rst' -!> -!> 2. The name of the output file to store the netCDF variables -!> (netcdf_output_file) -!> -!> In the process, the routine will find: -!> -!> 1. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. -!> (nBlocksLon, nBlocksLat, 1) -!> -!> 2. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) -!> -!> 3. The number of lon/lats in a single grid block (nxPerBlock, -!> nyPerBlock, nzPerBlock) -!> -!> 4. The number of neutral species (and probably a mapping between -!> the species number and the variable name) (nSpeciesTotal, nSpecies) -!> -!> 5. The number of ion species (ditto - numbers <-> names) (nIons) -!> -!> We assume that the 'UseTopography' flag is false - that all columns -!> have the same altitude arrays. This is true on earth but not on -!> other planets. -!> -!> In addition to reading in the state data, it fills Longitude, -!> Latitude, and Altitude arrays with the grid spacing. This grid -!> is orthogonal and rectangular but can have irregular spacing along -!> any or all of the three dimensions. +! Opens and closes the grid block file, but not the filter netcdf file. +call get_grid_from_blocks(restart_dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & + nxPerBlock, nyPerBlock, nzPerBlock, lons, lats, alts ) -subroutine restart_files_to_netcdf(restart_dirname, member, netcdf_output_file) +! Convert the Aether reference date (not calendar day = 0 date) +! to the days and seconds of the calendar set in model_mod_nml. +aeth_ref_time = set_date(aeth_ref_date(1), aeth_ref_date(2), aeth_ref_date(3), & + aeth_ref_date(4), aeth_ref_date(5)) +call get_time(aeth_ref_time,aeth_ref_nsecs,aeth_ref_ndays) -character(len=*), intent(in) :: restart_dirname -character(len=*), intent(in) :: netcdf_output_file -integer, intent(in) :: member +! Get the model time from a restart file. +aether_filename = block_file_name(variable_table(1,VT_ORIGININDX), 0, 0) +state_time = read_model_time(trim(restart_dirname)//'/'//trim(aether_filename)) -integer :: ncid - -character(len=*), parameter :: routine = 'restart_files_to_netcdf' - -if (module_initialized ) then - write(string1,*)'The aether static_init_model was already initialized but ',trim(routine),& - ' uses a separate initialization procedure' - call error_handler(E_ERR,routine,string1,source,revision,revdate) -end if - -call static_init_blocks(restart_dirname) +! TODO: Replace with aether variables check? (OR is that done when trying to read them?) +! call verify_block_variables( gitm_block_variables, nfields ) +! +! do ivar = 1, nfields +! +! varname = trim(gitm_block_variables(ivar)) +! gitmvar(ivar)%varname = varname +! +! ! This routine also checks to make sure user specified accurate GITM variables +! call decode_gitm_indices( varname, & +! gitmvar(ivar)%gitm_varname, & +! gitmvar(ivar)%gitm_dim, & +! gitmvar(ivar)%gitm_index, & +! gitmvar(ivar)%long_name, & +! gitmvar(ivar)%units) +! if ( debug > 0 ) then +! call print_gitmvar_info(ivar,routine) +! endif +! enddo -ncid = nc_create_file(netcdf_output_file) +if ( debug > 0 ) then + write(string1,'("grid: nlon, nlat, nalt =",3(1x,i5))') nlon, nlat, nalt + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif -! DONE: This should probably be replaced by nc_write_model_atts(ncid). -! That may require renaming some dimension variables. -! call add_nc_definitions(ncid) -! Enters and exits define mode; -call nc_write_model_atts(ncid, 0) +end subroutine static_init_blocks -call get_data(restart_dirname, ncid, member, define=.true.) +!================================================================== -! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts -! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying -! the state vector field names and source. -! call add_nc_dimvars(ncid) +subroutine read_model_namelist() -call get_data(restart_dirname, ncid, member, define=.false.) +integer :: iunit, io -! TODO: this needs to be updated to write to which file? -! call write_model_time(ncid, state_time) +! 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 nc_close_file(ncid) +! 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) -end subroutine restart_files_to_netcdf +end subroutine read_model_namelist !================================================================== -subroutine add_nc_definitions(ncid) +!> Read the grid dimensions from a restart netcdf file. +!> +!> The file name comes from module storage ... namelist. -integer, intent(in) :: ncid +subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, & + nalt, nBlocksLon, nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) -call nc_add_global_attribute(ncid, 'model', 'aether') +character(len=*), intent(in) :: restart_dirname +integer, intent(out) :: nlon ! Number of Longitude centers +integer, intent(out) :: nlat ! Number of Latitude centers +integer, intent(out) :: nalt ! Number of Vertical grid centers +integer, intent(out) :: nBlocksLon, nBlocksLat, nBlocksAlt +real(r8), intent(out) :: LatStart, LatEnd, LonStart -!------------------------------------------------------------------------------- -! Determine shape of most important namelist -!------------------------------------------------------------------------------- -! -!call find_textfile_dims('gitm_vars.nml', nlines, linelen) -!if (nlines > 0) then -! has_gitm_namelist = .true. -! -! allocate(textblock(nlines)) -! textblock = '' -! -! call nc_define_dimension(ncid, 'nlines', nlines) -! call nc_define_dimension(ncid, 'linelen', linelen) -! call nc_define_character_variable(ncid, 'gitm_in', (/ 'nlines ', 'linelen' /)) -! call nc_add_attribute_to_variable(ncid, 'gitm_in', 'long_name', 'contents of gitm_in namelist') -! -!else -! has_gitm_namelist = .false. -!endif -! -!---------------------------------------------------------------------------- -! output only grid info - state vars will be written by other non-model_mod code -!---------------------------------------------------------------------------- +! TODO: get the grid info from a namelists (98 variables), instead of GITM's UAM.in. +! Then remove functions read_in_*. +! The rest of the UAM.in contents are for running GITM. +! Can wait until aether_to_dart push is done. +character(len=*), parameter :: filename = 'UAM.in' -call nc_define_dimension(ncid, LON_DIM_NAME, nlon) -call nc_define_dimension(ncid, LAT_DIM_NAME, nlat) -call nc_define_dimension(ncid, ALT_DIM_NAME, nalt) -! TODO: is WL in Aether? No; remove from model_mod. -call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? +character(len=100) :: cLine ! iCharLen_ == 100 +character(len=256) :: fileloc -!---------------------------------------------------------------------------- -! Create the (empty) Coordinate Variables and the Attributes -!---------------------------------------------------------------------------- +integer :: i, iunit, ios -! TODO: This defines more attributes than TIEGCM. Prefer? Are these accurate for Aether? -! Grid Longitudes -call nc_define_double_variable(ncid, LON_VAR_NAME, (/ LON_DIM_NAME /) ) -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'type', 'x1d') -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'long_name', 'grid longitudes') -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'cartesian_axis', 'X') -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'units', 'degrees_east') -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'valid_range', (/ 0.0_r8, 360.0_r8 /) ) +character(len=*), parameter :: routine = 'get_grid_info_from_blocks' -! Grid Latitudes -call nc_define_double_variable(ncid, LAT_VAR_NAME, (/ LAT_DIM_NAME /) ) -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'type', 'y1d') -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'long_name', 'grid latitudes') -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'cartesian_axis', 'Y') -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'units', 'degrees_north') -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'valid_range', (/ -90.0_r8, 90.0_r8 /) ) +! get the ball rolling ... -! Grid Altitudes -call nc_define_double_variable(ncid, ALT_VAR_NAME, (/ ALT_DIM_NAME /) ) -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'type', 'z1d') -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'long_name', 'grid altitudes') -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'cartesian_axis', 'Z') -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'units', 'meters') -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'positive', 'up') +nBlocksLon = 0 +nBlocksLat = 0 +nBlocksAlt = 0 +LatStart = 0.0_r8 +LatEnd = 0.0_r8 +LonStart = 0.0_r8 -! Grid wavelengths -call nc_define_double_variable(ncid, 'WL', (/ 'WL' /) ) -call nc_add_attribute_to_variable(ncid, 'WL', 'type', 'x1d') -call nc_add_attribute_to_variable(ncid, 'WL', 'long_name', 'grid wavelengths') -call nc_add_attribute_to_variable(ncid, 'WL', 'cartesian_axis', 'X') -call nc_add_attribute_to_variable(ncid, 'WL', 'units', 'wavelength_index') -call nc_add_attribute_to_variable(ncid, 'WL', 'valid_range', (/ 0.9_r8, 38.1_r8 /) ) +write(fileloc,'(a,''/'',a)') trim(restart_dirname),trim(filename) -end subroutine add_nc_definitions +if (debug > 4) then + write(string1,*) 'Now opening Aether UAM file: ',trim(fileloc) + call error_handler(E_MSG,routine,string1,source,revision,revdate) +end if -!================================================================= -! open all restart files and read in the requested data item -subroutine get_data(dirname, ncid_output, member, define) +iunit = open_file(trim(fileloc), action='read') -character(len=*), intent(in) :: dirname -integer, intent(in) :: ncid_output, member -logical, intent(in) :: define +UAMREAD : do i = 1, 1000000 -integer :: ibLoop, jbLoop -integer :: ib, jb, nb, iunit + read(iunit,'(a)',iostat=ios) cLine -character(len=256) :: filename + if (ios /= 0) then + ! If we get to the end of the file or hit a read error without + ! finding what we need, die. + write(string1,*) 'cannot find #GRID in ',trim(fileloc) + call error_handler(E_ERR,'get_grid_info_from_blocks',string1,source,revision,revdate) + endif + if (cLine(1:5) .ne. "#GRID") cycle UAMREAD -if (define) then - ! if define, run one block. - ! the read_data_from_block call defines the variables in the whole domain netCDF file. - ibLoop = 1 - jbLoop = 1 - call nc_begin_define_mode(ncid_output) -else - ! if not define, run all blocks. - ! the read_data_from_block call adds the (ib,jb) block to a netCDF variable - ! in order to make a file containing the data for all the blocks. - ibLoop = nBlocksLon - jbLoop = nBlocksLat -end if + nBlocksLon = read_in_int( iunit,'NBlocksLon',trim(fileloc)) + nBlocksLat = read_in_int( iunit,'NBlocksLat',trim(fileloc)) + nBlocksAlt = read_in_int( iunit,'NBlocksAlt',trim(fileloc)) + LatStart = read_in_real(iunit,'LatStart', trim(fileloc)) + LatEnd = read_in_real(iunit,'LatEnd', trim(fileloc)) + LonStart = read_in_real(iunit,'LonStart', trim(fileloc)) -print*,'get_data: define = ',define -do jb = 1, jbLoop - do ib = 1, ibLoop + exit UAMREAD - call read_data_from_block(ncid_output, dirname, ib, jb, member, define) +enddo UAMREAD - enddo -enddo +if (debug > 4) then + write(string1,*) 'Successfully read Aether UAM grid file:',trim(fileloc) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nBlocksLon:',nBlocksLon + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nBlocksLat:',nBlocksLat + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nBlocksAlt:',nBlocksAlt + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' LatStart:',LatStart + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' LatEnd:',LatEnd + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' LonStart:',LonStart + call error_handler(E_MSG,routine,string1,source,revision,revdate) +end if -if (define) call nc_end_define_mode(ncid_output) +call close_file(iunit) -end subroutine get_data +end subroutine get_grid_info_from_blocks !================================================================== -!> Open all restart files and read in the requested data items. -!> The unpack* calls will write the data to the filter_input.nc. -!> -!> This is a two-pass method: first run through to define the NC variables -!> in the filter_input.nc (define = .true.), -!> then run again to write the data to the NC file(define = .false.) +function read_in_int(iunit,varname,filename) -subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) +integer, intent(in) :: iunit +character(len=*), intent(in) :: varname,filename +integer :: read_in_int -integer, intent(in) :: ncid_output -character(len=*), intent(in) :: dirname -integer, intent(in) :: ib, jb -integer, intent(in) :: member -logical, intent(in) :: define +character(len=100) :: cLine +integer :: i, ios -real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) -real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) -real(r4) :: temp0d !Alex: single parameter has "zero dimensions" -integer :: i, j, maxsize, ivar, nb, ncid_input -integer :: block(2) = 0 +! Read a line +read(iunit,'(a)',iostat=ios) cLine +if (ios /= 0) then + write(string1,*) 'cannot find '//trim(varname)//' in '//trim(filename) + call error_handler(E_ERR,'get_grid_dims',string1,source,revision,revdate) +endif -logical :: no_idensity +! Remove anything after a space or TAB +i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' +i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' -character(len=*), parameter :: routine = 'read_data_from_block' -character(len=128) :: file_root -character(len=256) :: filename -character(len=NF90_MAX_NAME) :: varname - -block(1) = ib -block(2) = jb -! The block number, as counted in Aether. -! Lower left is 0, increase to the East, then 1 row farther north, West to East. -nb = (jb-1) * nBlocksLon + ib - 1 +read(cLine,*,iostat=ios)read_in_int -! a temp array large enough to hold any of the -! Lon,Lat or Alt array from a block plus ghost cells -allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) +if(ios /= 0) then + write(string1,*)'unable to read '//trim(varname)//' in '//trim(filename) + call error_handler(E_ERR,'read_in_int',string1,source,revision,revdate,& + text2=cLine) +endif -! treat alt specially since we want to derive TEC here -! TODO: See density_ion_e too. -allocate( alt1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) +end function read_in_int -! temp array large enough to hold any 2D field -allocate(temp2d(1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost)) +!================================================================= -! TODO: We need all altitudes, but there might be vertical blocks in the future. -! But there would be no vertical halos. -! Make nzcount adapt to whether there are blocks. -! And temp needs to have C-ordering, which is what the restart files have. -! temp array large enough to hold 1 species, temperature, etc -allocate(temp3d(1:nzPerBlock, & - 1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost)) +function read_in_real(iunit,varname,filename) -! save density_ion_e to compute TEC -allocate(density_ion_e(1:nzPerBlock, & - 1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost)) +integer, intent(in) :: iunit +character(len=*), intent(in) :: varname,filename +real(r8) :: read_in_real -! Aether gives a unique name to each (of 6) velocity components -! ! temp array large enough to hold velocity vect, etc -! maxsize = max(3, nSpecies) -! allocate(temp4d(1-nGhost:nxPerBlock+nGhost, & -! 1-nGhost:nyPerBlock+nGhost, & -! 1-nGhost:nzPerBlock+nGhost, maxsize)) +character(len=100) :: cLine +integer :: i, ios +! Read a line +read(iunit,'(a)',iostat=ios) cLine +if (ios /= 0) then + write(string1,*) 'cannot find '//trim(varname)//' in '//trim(filename) + call error_handler(E_ERR,'get_grid_dims',string1,source,revision,revdate) +endif -! TODO; Does Aether need a replacement for these Density fields? Yes. -! But they are probably read by the loops below. -! Don't need to fetch index because Aether has NetCDF restarts, -! so just loop over the field names to read. -! Read the index from the first species -! call get_index_from_gitm_varname('NDensityS', inum, ivals) +! Remove anything after a space or TAB +i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' +i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' -! if (inum > 0) then -! ! if i equals ival, use the data from the state vect -! ! otherwise read/write what's in the input file -! j = 1 -! do i = 1, nSpeciesTotal -! if (debug > 80) then -! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading species ',i,' of ',nSpeciesTotal, & -! ' for block (',ib,',',jb,')' -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! read(iunit) temp3d -! if (j <= inum) then -! if (i == gitmvar(ivals(j))%gitm_index) then -! call unpack_data(temp3d, ivals(j), block, ncid, define) -! j = j + 1 -! endif -! endif -! enddo -! else -! if (debug > 80) then -! write(string1,'(A)') 'Not writing the NDensityS variables to file' -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! ! nothing at all from this variable in the state vector. -! ! copy all data over from the input file to output file -! do i = 1, nSpeciesTotal -! read(iunit) temp3d -! enddo -! endif -! -! call get_index_from_gitm_varname('IDensityS', inum, ivals) -! -! ! assume we could not find the electron density for VTEC calculations -! no_idensity = .true. -! -! if (inum > 0) then -! ! one or more items in the state vector need to replace the -! ! data in the output file. loop over the index list in order. -! j = 1 -! ! TODO: electron density is not in the restart files, but it's needed for TEC -! In Aether they will be from an ions file, but now only from an output file (2023-10-30). -! do i = 1, nIons -! if (debug > 80) then -! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & -! ' for block (',ib,',',jb,')' -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! read(iunit) temp3d -! if (j <= inum) then -! if (i == gitmvar(ivals(j))%gitm_index) then -! ! ie_, the gitm index for electron density, comes from ModEarth -! if (gitmvar(ivals(j))%gitm_index == ie_) then -! ! save the electron density for TEC computation -! density_ion_e(:,:,:) = temp3d(:,:,:) -! no_idensity = .false. -! end if -! ! read from input but write from state vector -! call unpack_data(temp3d, ivals(j), block, ncid, define) -! j = j + 1 -! endif -! endif -! enddo -! else -! ! nothing at all from this variable in the state vector. -! ! read past this variable -! if (debug > 80) then -! write(string1,'(A)') 'Not writing the IDensityS variables to file' -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! do i = 1, nIons -! read(iunit) temp3d -! enddo -! endif +! Now that we have a line with nothing else ... parse it +read(cLine,*,iostat=ios)read_in_real -! Handle the 2 restart file types (ions and neutrals). -! Each field has a file type associated with it: variable_table(f_index,VT_ORIGININDX) -! TODO: for now require that all neutrals are listed in variable_table before the ions. +if(ios /= 0) then + write(string1,*)'unable to read '//trim(varname)//' in '//trim(filename) + call error_handler(E_ERR,'read_in_real',string1,source,revision,revdate) +endif -file_root = variable_table(1,VT_ORIGININDX) -filename = block_file_name(file_root, member, nb) -ncid_input = open_block_file(trim(filename), 'read') +end function read_in_real -print*,'read_data_from_block: nfields_neutral = ',nfields_neutral -do ivar = 1, nfields_neutral - write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) +!================================================================= - ! TODO: Given the subroutine name, perhaps these definition sections should be - ! one call higher up, with the same loop around it. - if (define) then - ! Define the variable in the filter_input.nc file (the output from this program). - ! The calling routine entered define mode. +! open enough of the restart files to read in the lon, lat, alt arrays - if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',varname - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - - call nc_define_real_variable(ncid_output, varname, & - (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) - print*,routine,': defined ivar, varname = ', ivar, varname -! TODO: does the filter_input.nc file need all these attributes? TIEGCM doesn't add them. - ! They are not available from the restart files. - ! Add them to the ions section too. - ! call nc_add_attribute_to_variable(ncid, varname, 'long_name', gitmvar(ivar)%long_name) - ! call nc_add_attribute_to_variable(ncid, varname, 'units', gitmvar(ivar)%units) - ! !call nc_add_attribute_to_variable(ncid, varname, 'storder', gitmvar(ivar)%storder) - ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) - ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) - ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_index', gitmvar(ivar)%gitm_index) +subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & + nxPerBlock, nyPerBlock, nzPerBlock, & + lons, lats, alts ) +character(len=*), intent(in) :: dirname +integer, intent(in) :: nBlocksLon ! Number of Longitude blocks +integer, intent(in) :: nBlocksLat ! Number of Latitude blocks +integer, intent(in) :: nBlocksAlt ! Number of Altitude blocks +integer, intent(out) :: nxPerBlock ! Number of non-halo Longitude centers per block +integer, intent(out) :: nyPerBlock ! Number of non-halo Latitude centers per block +integer, intent(out) :: nzPerBlock ! Number of Vertical grid centers - else if (file_root == 'neutrals') then - ! Read 3D array and extract the non-halo data of this block. -! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. - call nc_get_variable(ncid_input, varname, temp3d, routine) - print*,'read_data_from_block: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),variable_table(ivar,VT_VARNAMEINDX) - print*,'read_data_from_block: define = ',define - call unpack_data(temp3d, ivar, block, ncid_output, define) - else - write(string1,*) 'Trying to read neutrals, but variable_table(',ivar,VT_ORIGININDX, & - ') /= "neutrals"' - call error_handler(E_ERR,routine,string1,source,revision,revdate) - endif +real(r8), allocatable , dimension( : ), intent(inout) :: lons, lats, alts -enddo -call nc_close_file(ncid_input) +integer :: ios, nb, offset, ncid, nboff +character(len=128) :: filename +real(r4), allocatable :: temp(:,:,:) +integer :: starts(3),ends(3), xcount, ycount, zcount -file_root = variable_table(nfields_neutral+1,VT_ORIGININDX) -filename = block_file_name(file_root, member, nb) -ncid_input = open_block_file(trim(filename), 'read') +character(len=*), parameter :: routine = 'get_grid_from_blocks' -print*,'read_data_from_block: nfields_ion = ',nfields_ion -do ivar = nfields_neutral +1,nfields_neutral + nfields_ion - write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) +! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), +! in order to calculate the n[xyz]PerBlock dimensions. +! grid_g0000.nc looks like a worthy candidate, but a restart could be used. +write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' +ncid = nc_open_file_readonly(filename, routine) - if (define) then +! The grid (and restart) file variables have halos, so strip them off +! to get the number of actual data values in each dimension of the block. +nxPerBlock = nc_get_dimension_size(ncid, 'x', routine) - 2*nGhost +nyPerBlock = nc_get_dimension_size(ncid, 'y', routine) - 2*nGhost +nzPerBlock = nc_get_dimension_size(ncid, 'z', routine) - if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',varname - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if - - call nc_define_real_variable(ncid_output, varname, & - (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) - print*,routine,': defined ivar, varname = ', ivar, varname +nlon = nBlocksLon * nxPerBlock +nlat = nBlocksLat * nyPerBlock +nalt = nBlocksAlt * nzPerBlock - else if (file_root == 'ions') then - call nc_get_variable(ncid_input, varname, temp3d, routine) - call unpack_data(temp3d, ivar, block, ncid_output, define) - else - write(string1,*) 'Trying to read ions, but variable_table(',ivar,VT_ORIGININDX, & - ') /= "ions"' - call error_handler(E_ERR,routine,string1,source,revision,revdate) - endif +write(string1,*) 'nlon = ', nlon +call error_handler(E_MSG,routine,string1,source,revision,revdate) +write(string1,*) 'nlat = ', nlat +call error_handler(E_MSG,routine,string1,source,revision,revdate) +write(string1,*) 'nalt = ', nalt +call error_handler(E_MSG,routine,string1,source,revision,revdate) -enddo -call nc_close_file(ncid_input) +! This is also done in gitm's static_init_model, which is not called by aether_to_dart, +! so it's not redundant. +allocate( lons( nlon )) +allocate( lats( nlat )) +allocate( alts( nalt )) -! TODO: Does Aether need TEC to be calculated? Yes -! ! add the VTEC as an extended-state variable -! ! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program -! call get_index_from_gitm_varname('TEC', inum, ivals) -! -! if (inum > 0 .and. no_idensity) then -! write(string1,*) 'Cannot compute the VTEC without the electron density' -! call error_handler(E_ERR,routine,string1,source,revision,revdate) -! end if -! -! if (inum > 0) then -! if (.not. define) then -! temp2d = 0._r8 -! ! comptue the TEC integral -! do i =1,nzPerBlock-1 ! approximate the integral over the altitude as a sum of trapezoids -! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 -! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 -! end do -! ! convert temp2d to TEC units -! temp2d = temp2d/1e16_r8 -! end if -! call unpack_data2d(temp2d, ivals(1), block, ncid, define) -! end if - -! TODO: Does Aether need f10_7 to be calculated or processed? Yes -! read(iunit) temp0d -! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') -! call get_index_from_gitm_varname('f107', inum, ivals) -! if (inum > 0) then -! call unpack_data0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine -! endif -! -! read(iunit) temp3d -! call get_index_from_gitm_varname('Rho', inum, ivals) -! if (inum > 0) then -! call unpack_data(temp3d, ivals(1), block, ncid, define) -! endif +if (debug > 4) then + write(string1,*) 'Successfully read GITM grid file:',trim(filename) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nxPerBlock:',nxPerBlock + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nyPerBlock:',nyPerBlock + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*) ' nzPerBlock:',nzPerBlock + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif -!print *, 'calling dealloc' -deallocate(temp1d, temp2d, temp3d) -deallocate(alt1d, density_ion_e) +! A temp array large enough to hold any of the 3D +! Lon,Lat or Alt arrays from a block plus ghost cells. +! The restart files have C-indexing (fastest changing dim is the last). +allocate(temp( 1:nzPerBlock, & + 1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost)) +temp = -888888. -end subroutine read_data_from_block +print*,'shape of temp = ',shape(temp) -!================================================================== +starts(1) = 1-nGhost +starts(2) = 1-nGhost +starts(3) = 1 +ends(1) = nxPerBlock+nGhost +ends(2) = nyPerBlock+nGhost +ends(3) = nzPerBlock +xcount = nxPerBlock + 2*nGhost +ycount = nyPerBlock + 2*nGhost +zcount = nzPerBlock +print*,'starts = ',starts +print*,'ends = ',ends +print*,'counts = ',xcount,ycount,zcount -!> TODO: Activate f10_7 code? -! !> put the f107 estimate (a scalar, hence 0d) into the state vector. -! !> Written specifically -! !> for f107 since f107 is the same for all blocks. So what it does -! !> is take f107 from the first block (block = 0) and disregard -! !> f107 values from all other blocks (hopefully they are the same). -! !> written by alex -! -! subroutine unpack_data0d(data0d, ivar, ncid, define) -! -! real(r8), intent(in) :: data0d -! integer, intent(in) :: ivar ! index into state structure -! integer, intent(in) :: ncid -! logical, intent(in) :: define -! -! -! character(len=*), parameter :: routine = 'unpack_data0d' -! -! if (define) then -! -! if (debug > 10) then -! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! -! call nc_define_double_scalar(ncid, gitmvar(ivar)%varname) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) -! -! else -! -! call nc_put_variable(ncid, gitmvar(ivar)%varname, data0d, context=routine) -! -! end if -! -! end subroutine unpack_data0d -! -! !================================================================== -! -! ! put the requested data into a netcdf variable -! -! subroutine unpack_data2d(data2d, ivar, block, ncid, define) -! -! real(r8), intent(in) :: data2d(1-nGhost:nxPerBlock+nGhost, & -! 1-nGhost:nyPerBlock+nGhost) -! -! integer, intent(in) :: ivar ! variable index -! integer, intent(in) :: block(2) -! integer, intent(in) :: ncid -! logical, intent(in) :: define -! -! integer :: ib, jb -! integer :: starts(2) -! character(len=*), parameter :: routine = 'unpack_data2d' -! -! if (define) then -! -! if (debug > 10) then -! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! -! call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME /) ) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) -! !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) -! -! else -! ib = block(1) -! jb = block(2) -! -! ! to compute the start, consider (ib-1)*nxPerBlock+1 -! starts(1) = (ib-1)*nxPerBlock+1 -! starts(2) = (jb-1)*nyPerBlock+1 -! -! call nc_put_variable(ncid, gitmvar(ivar)%varname, & -! data2d(1:nxPerBlock,1:nyPerBlock), & -! context=routine, nc_start=starts, & -! nc_count=(/nxPerBlock,nyPerBlock/)) -! end if -! -! end subroutine unpack_data2d +! go across the south-most block row picking up all longitudes +do nb = 1, nBlocksLon -!================================================================== + filename = block_file_name('grid', -1, nb-1) + ncid = open_block_file(trim(filename), 'read') -! put the requested data into a netcdf variable +! Read 3D array and extract the longitudes of the non-halo data of this block. +! This gets nc_get_double_3d, even though the fields are float. +!? Is there some environment setting that says float = double? +! ERROR This yields Start+count exceeds dimension bound +! call nc_get_variable(ncid, 'Longitude', temp, routine) +! ERROR: this yields Index exceeds dimension bound +! The restart files have C-indexing (fastest changing dim is the last), +! So invert the dimension bounds. + call nc_get_variable(ncid, 'Longitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + routine, & + nc_count=(/zcount,ycount,xcount/)) +! Shouldn't need to specify default values nc_start=(/1,1,1/), & -subroutine unpack_data(data3d, ivar, block, ncid, define) +! temp(1:zcount,1:ycount,1:xcount), & +! nc_start=(/starts(1),starts(2),starts(3)/), & +! TODO: nc_get_variable stops on error conditions, does not pass back ios. +! if ( ios /= 0 ) then +! print *,'size:',size(temp(1-nGhost:nxPerBlock+nGhost)) +! print *,'IO error code:',ios +! write(string1,*)'ERROR reading file ', trim(filename) +! write(string2,*)'longitude block ',nb,' of ',nBlocksLon +! call error_handler(E_ERR,'get_grid',string1, & +! source,revision,revdate,text2=string2) +! endif -real(r4), intent(in) :: data3d(1:nzPerBlock, & - 1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost) + offset = (nxPerBlock * (nb - 1)) + lons(offset+1:offset+nxPerBlock) = temp(1,1,1:nxPerBlock) -integer, intent(in) :: ivar ! variable index -integer, intent(in) :: block(2) -integer, intent(in) :: ncid + call nc_close_file(ncid) +enddo -integer :: ib, jb -integer :: starts(3) -character(len=*), parameter :: routine = 'unpack_data' -character(len=NF90_MAX_NAME) :: varname +! go up west-most block row picking up all latitudes +do nb = 1, nBlocksLat -print*,'unpack_data: data3d = ',data3d(1,1,1),data3d(15,15,15) -print*,'unpack_data: define = ',define + ! TODO; Aether block name counters start with 0, but the lat values can come from + ! any lon=const column. + nboff = ((nb - 1) * nBlocksLon) + filename = block_file_name('grid', -1, nboff) + ncid = open_block_file(trim(filename), 'read') -write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + call nc_get_variable(ncid, 'Latitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + routine, nc_count=(/zcount,ycount,xcount/)) + +! if ( ios /= 0 ) then +! write(string1,*)'ERROR reading file ', trim(filename) +! write(string2,*)'latitude block ',nb,' of ',nBlocksLat +! call error_handler(E_ERR,'get_grid',string1, & +! source,revision,revdate,text2=string2) +! endif -ib = block(1) -jb = block(2) + offset = (nyPerBlock * (nb - 1)) + lats(offset+1:offset+nyPerBlock) = temp(1,1:nyPerBlock,1) -! to compute the start, consider (ib-1)*nxPerBlock+1 -starts(1) = 1 -starts(2) = (jb-1)*nyPerBlock+1 -starts(3) = (ib-1)*nxPerBlock+1 + call nc_close_file(ncid) +enddo -call nc_put_variable(ncid, varname, & - data3d(1:nzPerBlock,1:nyPerBlock,1:nxPerBlock), & - context=routine, nc_start=starts, & - nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) -print*,'unpack_data: filled varname = ', varname -end subroutine unpack_data +! this code assumes UseTopography is false - that all columns share +! the same altitude array, so we can read it from the first block. +! if this is not the case, this code has to change. +filename = block_file_name('grid', -1, 0) +ncid = open_block_file(trim(filename), 'read') -!================================================================= -!> sort list x into order based on values in list. -!> should only be called on short ( < hundreds) of values or will be slow -!> @todo FIXME this should be using the sort module routine instead. - -subroutine sortindexlist(list, x, inum) - -integer, intent(inout) :: list(:) -integer, intent(inout) :: x(:) -integer, intent(in) :: inum - -integer :: tmp -integer :: j, k - -! DO A N^2 SORT - only use for short lists -do j = 1, inum - 1 - do k = j + 1, inum - ! if list() is in wrong order, exchange both list items and - ! items in x array. - if(list(j) .gt. list(k)) then - tmp = list(k) - list(k) = list(j) - list(j) = tmp - tmp = x(k) - x(k) = x(j) - x(j) = tmp - end if - end do -end do -end subroutine sortindexlist +temp = MISSING_R8 +call nc_get_variable(ncid, 'Altitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + routine, nc_count=(/zcount,ycount,xcount/)) +alts(1:nzPerBlock) = temp(1:nzPerBlock,1,1) +! print*,'temp = ',temp(:,1,1) +! print*,'alts = ',alts -!------------------------------------------------------------------------------- +call nc_close_file(ncid) -function get_model_size() -! Returns the size of the model as an integer. +deallocate(temp) -integer(i8) :: get_model_size +! convert from radians into degrees +lons = lons * RAD2DEG +lats = lats * RAD2DEG -if ( .not. module_initialized ) call static_init_model +if (debug > 4) then + print *, 'All lons ', lons + print *, 'All lats ', lats + print *, 'All alts ', alts +endif -get_model_size = model_size +if ( debug > 1 ) then ! Check dimension limits + write(string1,*)'LON range ',minval(lons),maxval(lons) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*)'LAT range ',minval(lats),maxval(lats) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,*)'ALT range ',minval(alts),maxval(alts) + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif -end function get_model_size +end subroutine get_grid_from_blocks !================================================================== -! TODO; will be provided by Ben's model_mod. -! - subroutine model_interpolate(state_handle, ens_size, location, iqty, obs_val, istatus) - ! Given a location, and a model state variable qty, - ! interpolates the state variable field to that location. - ! obs_val is the interpolated value for each ensemble member - ! istatus is the success (0) or failure of the interpolation - - type(ensemble_type), intent(in) :: state_handle - integer, intent(in) :: ens_size - type(location_type), intent(in) :: location - integer, intent(in) :: iqty - real(r8), intent(out) :: obs_val(ens_size) !< array of interpolated values - integer, intent(out) :: istatus(ens_size) - - integer :: which_vert - integer :: lat_below, lat_above, lon_below, lon_above ! these are indices - real(r8) :: lon_fract, lat_fract - real(r8) :: lon, lat, lon_lat_lev(3) - real(r8), dimension(ens_size) :: val11, val12, val21, val22 - real(r8) :: height - integer :: level, bogus_level - integer :: dom_id, var_id -! -! if ( .not. module_initialized ) call static_init_model -! -! ! Default for failure return -! istatus(:) = 1 -! obs_val(:) = MISSING_R8 -! -! ! Failure codes -! ! 11 QTY_GEOPOTENTIAL_HEIGHT is unsupported -! ! 22 unsupported veritcal coordinate -! ! 33 level given < or > model levels -! ! 44 quantity not part of the state -! ! 55 outside state (can not extrapolate above or below) -! ! 66 unknown vertical stagger -! -! ! GITM uses a vtec routine in obs_def_upper_atm_mod:get_expected_gnd_gps_vtec() -! ! TIEGCM has its own vtec routine, so we should use it. This next block ensures that. -! ! The get_expected_gnd_gps_vtec() tries to interpolate QTY_GEOPOTENTIAL_HEIGHT -! ! when it does, this will kill it. -! -! if ( iqty == QTY_GEOPOTENTIAL_HEIGHT ) then -! istatus(:) = 11 -! write(string1,*)'QTY_GEOPOTENTIAL_HEIGHT currently unsupported' -! call error_handler(E_ERR,'model_interpolate',string1,source, revision, revdate) -! endif -! -! -! ! Get the position -! lon_lat_lev = get_location(location) -! lon = lon_lat_lev(1) ! degree -! lat = lon_lat_lev(2) ! degree -! height = lon_lat_lev(3) ! level (int) or height (real) -! level = int(lon_lat_lev(3)) -! -! -! which_vert = nint(query_location(location)) -! -! call compute_bracketing_lat_indices(lat, lat_below, lat_above, lat_fract) -! call compute_bracketing_lon_indices(lon, lon_below, lon_above, lon_fract) -! -! ! Pressure is not part of the state vector -! ! pressure is static data on plevs/pilevs -! if ( iqty == QTY_PRESSURE) then -! if (which_vert == VERTISLEVEL) then -! ! @todo from Lanai code: -! ! Some variables need plevs, some need pilevs -! ! We only need the height (aka level) -! ! the obs_def_upper_atm_mod.f90:get_expected_O_N2_ratio routines queries -! ! for the pressure at the model levels - EXACTLY - so ... -! ! FIXME ... at present ... the only time model_interpolate -! ! gets called with QTY_PRESSURE is to calculate density, which -! ! requires other variables that only live on the midpoints. -! ! I cannot figure out how to generically decide when to -! ! use plevs vs. pilevs -! -! ! Check to make sure vertical level is possible. -! if ((level < 1) .or. (level > nalt)) then -! istatus(:) = 33 -! return -! else -! obs_val(:) = plevs(level) -! istatus(:) = 0 -! endif -! elseif (which_vert == VERTISHEIGHT) then -! -! ! @todo from Lanai code: -! ! FIXME ... is it possible to try to get a pressure with which_vert == undefined -! ! At present, vert_interp will simply fail because height is a negative number. -! ! @todo HK what are you supposed to do for pressure with VERTISUNDEF? level 1? -! -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) -! if (any(istatus /= 0)) return ! bail at the first failure -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) -! if (any(istatus /= 0)) return -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) -! if (any(istatus /= 0)) return -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! else -! -! write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' -! call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) -! -! endif ! which vert -! -! return -! -! endif ! end of QTY_PRESSURE -! -! -! if ( iqty == QTY_VERTICAL_TEC ) then ! extrapolate vtec -! -! call extrapolate_vtec(state_handle, ens_size, lon_below, lat_below, val11) -! call extrapolate_vtec(state_handle, ens_size, lon_below, lat_above, val11) -! call extrapolate_vtec(state_handle, ens_size, lon_above, lat_below, val11) -! call extrapolate_vtec(state_handle, ens_size, lon_above, lat_above, val11) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! istatus(:) = 0 -! -! return -! endif -! -! ! check if qty is in the state vector -! call find_qty_in_state(iqty, dom_id, var_id) -! if (dom_id < 0 ) then -! istatus(:) = 44 -! return -! endif -! -! if( which_vert == VERTISHEIGHT ) then -! -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) -! if (any(istatus /= 0)) return ! bail at the first failure -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) -! if (any(istatus /= 0)) return -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) -! if (any(istatus /= 0)) return -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! istatus = 0 -! elseif( which_vert == VERTISLEVEL) then -! ! Check to make sure vertical level is possible. -! if ((level < 1) .or. (level > nilev)) then -! istatus(:) = 33 -! return -! endif -! -! ! one use of model_interpolate is to allow other modules/routines -! ! the ability to 'count' the model levels. To do this, create observations -! ! with locations on model levels and 'interpolate' for QTY_GEOMETRIC_HEIGHT. -! ! When the interpolation fails, you've gone one level too far. -! ! HK why does it have to be QTY_GEOMETRIC_HEIGHT? -! -! val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, level, domain_id(dom_id), var_id ), state_handle) -! val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, level, domain_id(dom_id), var_id ), state_handle) -! val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, level, domain_id(dom_id), var_id ), state_handle) -! val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, level, domain_id(dom_id), var_id ), state_handle) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! istatus = 0 -! -! elseif( which_vert == VERTISUNDEF) then -! bogus_level = 1 !HK what should this be? Do only 2D fields have VERTISUNDEF? -! val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) -! val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) -! val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) -! val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! istatus(:) = 0 -! -! else -! -! write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' -! call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) -! -! endif -! - end subroutine model_interpolate -!------------------------------------------------------------------------------- -function shortest_time_between_assimilations() -type(time_type) :: shortest_time_between_assimilations +!> open the requested restart file and return the ncid -shortest_time_between_assimilations = time_step +function open_block_file(filename,rw) -end function shortest_time_between_assimilations +character(len=*), intent(in) :: filename +character(len=*), intent(in) :: rw ! 'read' or 'readwrite' +integer :: open_block_file + +character(len=*), parameter :: routine = 'open_block_file' + +if ( rw == 'read' .and. .not. file_exist(trim(filename)) ) then + write(string1,*) 'cannot open file ', trim(filename),' for reading.' + call error_handler(E_ERR,'open_block_file',string1,source,revision,revdate) +endif + +if (debug > 0) then + write(string1,*) 'Opening file ', trim(filename), ' for ', trim(rw) + call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) +end if + +open_block_file = nc_open_file_readonly(trim(filename), routine) + +if (debug > 80) then + write(string1,*) 'Returned file descriptor is ', open_block_file + call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) +end if + +end function open_block_file + +!================================================================= + +subroutine verify_block_variables( variable_array, ngood) + +character(len=*), dimension(:), intent(in) :: variable_array +integer, intent(out) :: ngood + +integer :: nrows, i +character(len=NF90_MAX_NAME) :: varname + +character(len=*), parameter :: routine = 'verify_state_variables' + +nrows = size(variable_array,1) + +ngood = 0 +MyLoop : do i = 1, nrows + + varname = variable_array(i) + + if ( varname == ' ') exit MyLoop ! Found end of list. + + ngood = ngood + 1 +enddo MyLoop + +if (ngood == nrows) then + string1 = 'WARNING: There is a possibility you need to increase ''max_state_variables''' + write(string2,'(''WARNING: you have specified at least '',i4,'' perhaps more.'')')ngood + call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2) +endif + +end subroutine verify_block_variables !================================================================== -! - subroutine get_state_meta_data(index_in, location, var_qty) - ! Given an integer index into the state vector, returns the - ! associated location and optionally the variable quantity. - - integer(i8), intent(in) :: index_in - type(location_type), intent(out) :: location - integer, optional, intent(out) :: var_qty - - integer :: lon_index, lat_index, lev_index - integer :: local_qty, var_id, dom_id - integer :: seconds, days ! for f10.7 location - real(r8) :: longitude ! for f10.7 location - character(len=NF90_MAX_NAME) :: dim_name - -! if ( .not. module_initialized ) call static_init_model -! -! call get_model_variable_indices(index_in, lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id, kind_index=local_qty) -! -! if(present(var_qty)) var_qty = local_qty -! -! if (get_variable_name(dom_id, var_id) == 'f10_7') then -! ! f10_7 is most accurately located at local noon at equator. -! ! 360.0 degrees in 86400 seconds, 43200 secs == 12:00 UTC == longitude 0.0 -! -! call get_time(state_time, seconds, days) -! longitude = 360.0_r8 * real(seconds,r8) / 86400.0_r8 - 180.0_r8 -! if (longitude < 0.0_r8) longitude = longitude + 360.0_r8 -! location = set_location(longitude, 0.0_r8, 400000.0_r8, VERTISUNDEF) -! return -! end if -! -! ! search for either ilev or lev -! dim_name = ilev_or_lev(dom_id, var_id) -! -! select case (trim(dim_name)) -! case ('ilev') -! location = set_location(lons(lon_index), lats(lat_index), ilevs(lev_index), VERTISLEVEL) -! case (ALT_DIM_NAME) -! location = set_location(lons(lon_index), lats(lat_index), alts(lev_index), VERTISLEVEL) -! case default -! call error_handler(E_ERR, 'get_state_meta_data', 'expecting ilev or ilat dimension') -! ! HK @todo 2D variables. -! end select -! - end subroutine get_state_meta_data - -!================================================================== -subroutine end_model() -! Does any shutdown and clean-up needed for model. +subroutine add_nc_definitions(ncid) + +integer, intent(in) :: ncid + +call nc_add_global_attribute(ncid, 'model', 'aether') + +!------------------------------------------------------------------------------- +! Determine shape of most important namelist +!------------------------------------------------------------------------------- +! +!call find_textfile_dims('gitm_vars.nml', nlines, linelen) +!if (nlines > 0) then +! has_gitm_namelist = .true. +! +! allocate(textblock(nlines)) +! textblock = '' +! +! call nc_define_dimension(ncid, 'nlines', nlines) +! call nc_define_dimension(ncid, 'linelen', linelen) +! call nc_define_character_variable(ncid, 'gitm_in', (/ 'nlines ', 'linelen' /)) +! call nc_add_attribute_to_variable(ncid, 'gitm_in', 'long_name', 'contents of gitm_in namelist') +! +!else +! has_gitm_namelist = .false. +!endif +! +!---------------------------------------------------------------------------- +! output only grid info - state vars will be written by other non-model_mod code +!---------------------------------------------------------------------------- + +call nc_define_dimension(ncid, LON_DIM_NAME, nlon) +call nc_define_dimension(ncid, LAT_DIM_NAME, nlat) +call nc_define_dimension(ncid, ALT_DIM_NAME, nalt) +! TODO: is WL in Aether? No; remove from model_mod. +call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? + +!---------------------------------------------------------------------------- +! Create the (empty) Coordinate Variables and the Attributes +!---------------------------------------------------------------------------- + +! TODO: This defines more attributes than TIEGCM. Prefer? Are these accurate for Aether? +! Grid Longitudes +call nc_define_double_variable(ncid, LON_VAR_NAME, (/ LON_DIM_NAME /) ) +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'type', 'x1d') +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'long_name', 'grid longitudes') +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'cartesian_axis', 'X') +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'units', 'degrees_east') +call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'valid_range', (/ 0.0_r8, 360.0_r8 /) ) + +! Grid Latitudes +call nc_define_double_variable(ncid, LAT_VAR_NAME, (/ LAT_DIM_NAME /) ) +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'type', 'y1d') +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'long_name', 'grid latitudes') +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'cartesian_axis', 'Y') +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'units', 'degrees_north') +call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'valid_range', (/ -90.0_r8, 90.0_r8 /) ) + +! Grid Altitudes +call nc_define_double_variable(ncid, ALT_VAR_NAME, (/ ALT_DIM_NAME /) ) +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'type', 'z1d') +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'long_name', 'grid altitudes') +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'cartesian_axis', 'Z') +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'units', 'meters') +call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'positive', 'up') + +! Grid wavelengths +call nc_define_double_variable(ncid, 'WL', (/ 'WL' /) ) +call nc_add_attribute_to_variable(ncid, 'WL', 'type', 'x1d') +call nc_add_attribute_to_variable(ncid, 'WL', 'long_name', 'grid wavelengths') +call nc_add_attribute_to_variable(ncid, 'WL', 'cartesian_axis', 'X') +call nc_add_attribute_to_variable(ncid, 'WL', 'units', 'wavelength_index') +call nc_add_attribute_to_variable(ncid, 'WL', 'valid_range', (/ 0.9_r8, 38.1_r8 /) ) + +end subroutine add_nc_definitions + +!================================================================= +! open all restart files and read in the requested data item + +subroutine get_data(dirname, ncid_output, member, define) + +character(len=*), intent(in) :: dirname +integer, intent(in) :: ncid_output, member +logical, intent(in) :: define -end subroutine end_model +integer :: ibLoop, jbLoop +integer :: ib, jb, nb, iunit -!================================================================== +character(len=256) :: filename -! Writes the model-specific attributes to a netCDF file. -subroutine nc_write_model_atts( ncid, dom_id) -integer, intent(in) :: ncid ! netCDF file identifier -integer, intent(in) :: dom_id +if (define) then + ! if define, run one block. + ! the read_data_from_block call defines the variables in the whole domain netCDF file. + ibLoop = 1 + jbLoop = 1 + call nc_begin_define_mode(ncid_output) +else + ! if not define, run all blocks. + ! the read_data_from_block call adds the (ib,jb) block to a netCDF variable + ! in order to make a file containing the data for all the blocks. + ibLoop = nBlocksLon + jbLoop = nBlocksLat +end if -real(r8), allocatable :: temp_lons(:) -character(len=*), parameter :: routine = 'nc_write_model_atts' +print*,'get_data: define = ',define +do jb = 1, jbLoop + do ib = 1, ibLoop -if ( .not. module_initialized ) call static_init_model + call read_data_from_block(ncid_output, dirname, ib, jb, member, define) -! Write Global Attributes + enddo +enddo -call nc_add_global_creation_time(ncid, routine) +if (define) call nc_end_define_mode(ncid_output) -call nc_add_global_attribute(ncid, "model_source", source, routine) -call nc_add_global_attribute(ncid, "model", "Aether", routine) +end subroutine get_data +!================================================================== -! define grid dimensions -call nc_define_dimension(ncid, LON_DIM_NAME, nlon, routine) -call nc_define_dimension(ncid, LAT_DIM_NAME, nlat, routine) -call nc_define_dimension(ncid, ALT_DIM_NAME, nalt, routine) -call nc_define_dimension(ncid, 'ilev', nilev, routine) +!> Open all restart files and read in the requested data items. +!> The unpack* calls will write the data to the filter_input.nc. +!> +!> This is a two-pass method: first run through to define the NC variables +!> in the filter_input.nc (define = .true.), +!> then run again to write the data to the NC file(define = .false.) -! define grid variables -! longitude -call nc_define_real_variable( ncid, LON_DIM_NAME, (/ LON_DIM_NAME /), routine) -call nc_add_attribute_to_variable(ncid, LON_DIM_NAME, 'long_name', 'geographic longitude (-west, +east)', routine) -call nc_add_attribute_to_variable(ncid, LON_DIM_NAME, 'units', 'degrees_east', routine) +subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) -! latitude -call nc_define_real_variable( ncid, LAT_DIM_NAME, (/ LAT_DIM_NAME /), routine) -call nc_add_attribute_to_variable(ncid, LAT_DIM_NAME, 'long_name', 'geographic latitude (-south, +north)', routine) -call nc_add_attribute_to_variable(ncid, LAT_DIM_NAME, 'units', 'degrees_north', routine) +integer, intent(in) :: ncid_output +character(len=*), intent(in) :: dirname +integer, intent(in) :: ib, jb +integer, intent(in) :: member +logical, intent(in) :: define -! alts -call nc_define_real_variable( ncid, ALT_DIM_NAME, (/ ALT_DIM_NAME /), routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'long_name', 'midpoint altitudes', routine) -! DONE: vert coord is altitude, not ... -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'short name', 'altitude', routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'positive', 'up', routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'standard_name', 'unknown', routine) -! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula_terms', 'p0: p0 lev: lev', routine) -! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-lev(k))', routine) +real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) +real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) +real(r4) :: temp0d !Alex: single parameter has "zero dimensions" +integer :: i, j, maxsize, ivar, nb, ncid_input +integer :: block(2) = 0 +logical :: no_idensity -! ilevs -! call nc_define_real_variable( ncid, 'ilev', (/ 'ilev' /), routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'long_name', 'interface levels', routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'short name', 'ln(p0/p)', routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'positive', 'up', routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'formula_terms', 'p0: p0 lev: ilev', routine) -! ! TODO: Is there an interface alt? -! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-ilev(k))', routine) +character(len=*), parameter :: routine = 'read_data_from_block' +character(len=128) :: file_root +character(len=256) :: filename +character(len=NF90_MAX_NAME) :: varname +block(1) = ib +block(2) = jb +! The block number, as counted in Aether. +! Lower left is 0, increase to the East, then 1 row farther north, West to East. +nb = (jb-1) * nBlocksLon + ib - 1 -call nc_end_define_mode(ncid, routine) +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) -!------------------------------------------------------------------------------- -! Write variables -!------------------------------------------------------------------------------- +! treat alt specially since we want to derive TEC here +! TODO: See density_ion_e too. +allocate( alt1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) -! TODO: Should nc_write_model_atts write dimension contents, not just atts? -! Gitm had a separate routine for filling the dimensions: -! - - - - - - - - - - - -! subroutine add_nc_dimvars(ncid) -! -! integer, intent(in) :: ncid -! -! !---------------------------------------------------------------------------- -! ! Fill the coordinate variables -! !---------------------------------------------------------------------------- -! -! call nc_put_variable(ncid, LON_VAR_NAME, lons) -! call nc_put_variable(ncid, LAT_VAR_NAME, lats) -! call nc_put_variable(ncid, ALT_VAR_NAME, alts) -! ! what about WL? +! temp array large enough to hold any 2D field +allocate(temp2d(1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost)) + +! TODO: We need all altitudes, but there might be vertical blocks in the future. +! But there would be no vertical halos. +! Make nzcount adapt to whether there are blocks. +! And temp needs to have C-ordering, which is what the restart files have. +! temp array large enough to hold 1 species, temperature, etc +allocate(temp3d(1:nzPerBlock, & + 1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost)) + +! save density_ion_e to compute TEC +allocate(density_ion_e(1:nzPerBlock, & + 1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost)) + +! Aether gives a unique name to each (of 6) velocity components +! ! temp array large enough to hold velocity vect, etc +! maxsize = max(3, nSpecies) +! allocate(temp4d(1-nGhost:nxPerBlock+nGhost, & +! 1-nGhost:nyPerBlock+nGhost, & +! 1-nGhost:nzPerBlock+nGhost, maxsize)) + + +! TODO; Does Aether need a replacement for these Density fields? Yes. +! But they are probably read by the loops below. +! Don't need to fetch index because Aether has NetCDF restarts, +! so just loop over the field names to read. +! Read the index from the first species +! call get_index_from_gitm_varname('NDensityS', inum, ivals) + +! if (inum > 0) then +! ! if i equals ival, use the data from the state vect +! ! otherwise read/write what's in the input file +! j = 1 +! do i = 1, nSpeciesTotal +! if (debug > 80) then +! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading species ',i,' of ',nSpeciesTotal, & +! ' for block (',ib,',',jb,')' +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! read(iunit) temp3d +! if (j <= inum) then +! if (i == gitmvar(ivals(j))%gitm_index) then +! call unpack_data(temp3d, ivals(j), block, ncid) +! j = j + 1 +! endif +! endif +! enddo +! else +! if (debug > 80) then +! write(string1,'(A)') 'Not writing the NDensityS variables to file' +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! ! nothing at all from this variable in the state vector. +! ! copy all data over from the input file to output file +! do i = 1, nSpeciesTotal +! read(iunit) temp3d +! enddo +! endif ! -! !if (has_gitm_namelist) then -! ! call file_to_text('gitm_vars.nml', textblock) -! ! call nc_put_variable(ncid, 'gitm_in', textblock) -! ! deallocate(textblock) -! !endif +! call get_index_from_gitm_varname('IDensityS', inum, ivals) ! -! !------------------------------------------------------------------------------- -! ! Flush the buffer and leave netCDF file open -! !------------------------------------------------------------------------------- -! call nc_synchronize_file(ncid) +! ! assume we could not find the electron density for VTEC calculations +! no_idensity = .true. ! -! end subroutine add_nc_dimvars -! - - - - - - - - - - - +! if (inum > 0) then +! ! one or more items in the state vector need to replace the +! ! data in the output file. loop over the index list in order. +! j = 1 +! ! TODO: electron density is not in the restart files, but it's needed for TEC +! In Aether they will be from an ions file, but now only from an output file (2023-10-30). +! do i = 1, nIons +! if (debug > 80) then +! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & +! ' for block (',ib,',',jb,')' +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! read(iunit) temp3d +! if (j <= inum) then +! if (i == gitmvar(ivals(j))%gitm_index) then +! ! ie_, the gitm index for electron density, comes from ModEarth +! if (gitmvar(ivals(j))%gitm_index == ie_) then +! ! save the electron density for TEC computation +! density_ion_e(:,:,:) = temp3d(:,:,:) +! no_idensity = .false. +! end if +! ! read from input but write from state vector +! call unpack_data(temp3d, ivals(j), block, ncid) +! j = j + 1 +! endif +! endif +! enddo +! else +! ! nothing at all from this variable in the state vector. +! ! read past this variable +! if (debug > 80) then +! write(string1,'(A)') 'Not writing the IDensityS variables to file' +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! do i = 1, nIons +! read(iunit) temp3d +! enddo +! endif + +! Handle the 2 restart file types (ions and neutrals). +! Each field has a file type associated with it: variable_table(f_index,VT_ORIGININDX) +! TODO: for now require that all neutrals are listed in variable_table before the ions. + +file_root = variable_table(1,VT_ORIGININDX) +filename = block_file_name(file_root, member, nb) +ncid_input = open_block_file(trim(filename), 'read') + +print*,'read_data_from_block: nfields_neutral = ',nfields_neutral +do ivar = 1, nfields_neutral + write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + + ! TODO: Given the subroutine name, perhaps these definition sections should be + ! one call higher up, with the same loop around it. + if (define) then + ! Define the variable in the filter_input.nc file (the output from this program). + ! The calling routine entered define mode. + if (debug > 10) then + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',varname + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + + call nc_define_real_variable(ncid_output, varname, & + (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) + print*,routine,': defined ivar, varname = ', ivar, varname +! TODO: does the filter_input.nc file need all these attributes? TIEGCM doesn't add them. + ! They are not available from the restart files. + ! Add them to the ions section too. + ! call nc_add_attribute_to_variable(ncid, varname, 'long_name', gitmvar(ivar)%long_name) + ! call nc_add_attribute_to_variable(ncid, varname, 'units', gitmvar(ivar)%units) + ! !call nc_add_attribute_to_variable(ncid, varname, 'storder', gitmvar(ivar)%storder) + ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) + ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) + ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_index', gitmvar(ivar)%gitm_index) -! Fill in the coordinate variables -! longitude - Aether uses values +/- pi, but lons has been converted already. -! DART uses values [0,360] -allocate(temp_lons(nlon)) -temp_lons = lons -where (temp_lons < 0.0_r8) temp_lons = temp_lons + 360.0_r8 -! where (temp_lons >= 180.0_r8) temp_lons = temp_lons - 360.0_r8 -call nc_put_variable(ncid, LON_VAR_NAME, temp_lons, routine) -call nc_put_variable(ncid, LAT_VAR_NAME, lats, routine) -call nc_put_variable(ncid, ALT_VAR_NAME, alts, routine) -! call nc_put_variable(ncid, 'ilev', ilevs, routine) -deallocate(temp_lons) + else if (file_root == 'neutrals') then + ! Read 3D array and extract the non-halo data of this block. +! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. + call nc_get_variable(ncid_input, varname, temp3d, routine) + print*,'read_data_from_block: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),variable_table(ivar,VT_VARNAMEINDX) + print*,'read_data_from_block: define = ',define + call unpack_data(temp3d, ivar, block, ncid_output) + else + write(string1,*) 'Trying to read neutrals, but variable_table(',ivar,VT_ORIGININDX, & + ') /= "neutrals"' + call error_handler(E_ERR,routine,string1,source,revision,revdate) + endif -! flush any pending i/o to disk -call nc_synchronize_file(ncid, routine) +enddo +call nc_close_file(ncid_input) -end subroutine nc_write_model_atts +file_root = variable_table(nfields_neutral+1,VT_ORIGININDX) +filename = block_file_name(file_root, member, nb) +ncid_input = open_block_file(trim(filename), 'read') -!================================================================== +print*,'read_data_from_block: nfields_ion = ',nfields_ion +do ivar = nfields_neutral +1,nfields_neutral + nfields_ion + write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) -! TODO: this will be replaced by Ben. -! Vertical localization is done only in height (ZG). -! obs vertical location is given in height (model_interpolate). -! state vertical location is given in height. -subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & - num_close, close_ind, dist, state_handle) + if (define) then -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) :: state_handle + if (debug > 10) then + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',varname + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if + + call nc_define_real_variable(ncid_output, varname, & + (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) + print*,routine,': defined ivar, varname = ', ivar, varname -integer :: k, q_ind -integer :: n -integer :: istatus + else if (file_root == 'ions') then + call nc_get_variable(ncid_input, varname, temp3d, routine) + call unpack_data(temp3d, ivar, block, ncid_output) + else + write(string1,*) 'Trying to read ions, but variable_table(',ivar,VT_ORIGININDX, & + ') /= "ions"' + call error_handler(E_ERR,routine,string1,source,revision,revdate) + endif -! n = size(locs) -! -! if (vertical_localization_on()) then ! need to get height -! call convert_vertical_state(state_handle, n, locs, loc_qtys, loc_indx, VERTISHEIGHT, istatus) ! HK Do we care about istatus? -! endif -! -! call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & -! num_close, close_ind, dist) -! -! ! Make the ZG part of the state vector far from everything so it does not get updated. -! ! HK Note if you have inflation on ZG has been inflated. -! ! Scroll through all the obs_loc(:) and obs_kind(:) elements -! -! do k = 1,num_close -! q_ind = close_ind(k) -! if (loc_qtys(q_ind) == QTY_GEOMETRIC_HEIGHT) then -! if (do_output() .and. (debug > 99)) then -! write( * ,*)'get_close_state ZG distance is ', & -! dist(k),' changing to ',10.0_r8 * PI -! write(logfileunit,*)'get_close_state ZG distance is ', & -! dist(k),' changing to ',10.0_r8 * PI -! endif -! dist(k) = 10.0_r8 * PI -! endif -! enddo +enddo +call nc_close_file(ncid_input) + +! TODO: Does Aether need TEC to be calculated? Yes +! ! add the VTEC as an extended-state variable +! ! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program +! call get_index_from_gitm_varname('TEC', inum, ivals) ! +! if (inum > 0 .and. no_idensity) then +! write(string1,*) 'Cannot compute the VTEC without the electron density' +! call error_handler(E_ERR,routine,string1,source,revision,revdate) +! end if ! -! if (estimate_f10_7) then -! ! f10_7 is given a location of latitude 0.0 and the longitude -! ! of local noon. By decreasing the distance from the observation -! ! to the dynamic f10_7 location we are allowing the already close -! ! observations to have a larger impact in the parameter estimation. -! ! 0.25 is heuristic. The 'close' observations have already been -! ! determined by the cutoff. Changing the distance here does not -! ! allow more observations to impact anything. -! do k = 1, num_close -! q_ind = close_ind(k) -! if (loc_qtys(q_ind) == QTY_1D_PARAMETER) then -! dist(k) = dist(k)*0.25_r8 -! endif -! enddo +! if (inum > 0) then +! if (.not. define) then +! temp2d = 0._r8 +! ! comptue the TEC integral +! do i =1,nzPerBlock-1 ! approximate the integral over the altitude as a sum of trapezoids +! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 +! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 +! end do +! ! convert temp2d to TEC units +! temp2d = temp2d/1e16_r8 +! end if +! call unpack_data2d(temp2d, ivals(1), block, ncid, define) +! end if + +! TODO: Does Aether need f10_7 to be calculated or processed? Yes +! read(iunit) temp0d +! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') +! call get_index_from_gitm_varname('f107', inum, ivals) +! if (inum > 0) then +! call unpack_data0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine ! endif ! -! -end subroutine get_close_state - -!================================================================== - -subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, & - which_vert, istatus) +! read(iunit) temp3d +! call get_index_from_gitm_varname('Rho', inum, ivals) +! if (inum > 0) then +! call unpack_data(temp3d, ivals(1), block, ncid) +! endif -type(ensemble_type), intent(in) :: state_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) :: istatus(:) +!print *, 'calling dealloc' +deallocate(temp1d, temp2d, temp3d) +deallocate(alt1d, density_ion_e) -integer :: current_vert_type, i -real(r8) :: height(1) -integer :: local_status(1) +end subroutine read_data_from_block -character(len=*), parameter :: routine = 'convert_vertical_obs' +!================================================================== -! if ( which_vert == VERTISHEIGHT .or. which_vert == VERTISUNDEF) then -! istatus(:) = 0 -! return -! endif +!> TODO: Activate f10_7 code? +! !> put the f107 estimate (a scalar, hence 0d) into the state vector. +! !> Written specifically +! !> for f107 since f107 is the same for all blocks. So what it does +! !> is take f107 from the first block (block = 0) and disregard +! !> f107 values from all other blocks (hopefully they are the same). +! !> written by alex ! -! do i = 1, num -! current_vert_type = nint(query_location(locs(i))) -! if (( current_vert_type == which_vert ) .or. & -! ( current_vert_type == VERTISUNDEF)) then -! istatus(i) = 0 -! cycle -! endif +! subroutine unpack_data0d(data0d, ivar, ncid, define) ! -! call model_interpolate(state_handle, 1, locs(i), QTY_GEOMETRIC_HEIGHT, height, local_status ) +! real(r8), intent(in) :: data0d +! integer, intent(in) :: ivar ! index into state structure +! integer, intent(in) :: ncid +! logical, intent(in) :: define +! +! +! character(len=*), parameter :: routine = 'unpack_data0d' +! +! if (define) then ! -! if (local_status(1) == 0) call set_vertical(locs(i), height(1), VERTISHEIGHT) -! istatus(i) = local_status(1) +! if (debug > 10) then +! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if ! -! enddo +! call nc_define_double_scalar(ncid, gitmvar(ivar)%varname) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) ! -end subroutine convert_vertical_obs - -!================================================================== - 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 - - integer :: var_id, dom_id, lon_index, lat_index, lev_index - integer :: i - real(r8) :: height(1), height1(1), height2(1) - character(len=NF90_MAX_NAME) :: dim_name - integer(i8) :: height_idx - - -! if ( which_vert /= VERTISHEIGHT ) then -! call error_handler(E_ERR,'convert_vertical_state', 'only supports VERTISHEIGHT') -! endif +! else +! +! call nc_put_variable(ncid, gitmvar(ivar)%varname, data0d, context=routine) +! +! end if +! +! end subroutine unpack_data0d ! -! istatus = 0 !HK what are you doing with this? +! !================================================================== ! -! do i = 1, num +! ! put the requested data into a netcdf variable ! -! call get_model_variable_indices(loc_indx(i), lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id) -! -! ! search for either ilev or lev -! dim_name = ilev_or_lev(dom_id, var_id) -! -! select case (trim(dim_name)) -! case ('ilev') -! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & -! domain_id(SECONDARY_DOM), ivarZG) -! height = get_state(height_idx, state_handle)/100.0_r8 -! -! case (ALT_DIM_NAME) ! height on midpoint -! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & -! domain_id(SECONDARY_DOM), ivarZG) -! height1 = get_state(height_idx, state_handle)/100.0_r8 -! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index+1, & -! domain_id(SECONDARY_DOM), ivarZG) -! height2 = get_state(height_idx, state_handle)/100.0_r8 -! height = (height1 + height2) / 2.0_r8 -! -! case default -! call error_handler(E_ERR, 'convert_vertical_state', 'expecting ilev or ilat dimension') -! end select -! -! locs(i) = set_location(lons(lon_index), lats(lat_index), height(1), VERTISHEIGHT) +! subroutine unpack_data2d(data2d, ivar, block, ncid, define) ! -! end do +! real(r8), intent(in) :: data2d(1-nGhost:nxPerBlock+nGhost, & +! 1-nGhost:nyPerBlock+nGhost) ! -end subroutine convert_vertical_state +! integer, intent(in) :: ivar ! variable index +! integer, intent(in) :: block(2) +! integer, intent(in) :: ncid +! logical, intent(in) :: define +! +! integer :: ib, jb +! integer :: starts(2) +! character(len=*), parameter :: routine = 'unpack_data2d' +! +! if (define) then +! +! if (debug > 10) then +! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) +! call error_handler(E_MSG,routine,string1,source,revision,revdate) +! end if +! +! call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME /) ) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) +! !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) +! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) +! +! else +! ib = block(1) +! jb = block(2) +! +! ! to compute the start, consider (ib-1)*nxPerBlock+1 +! starts(1) = (ib-1)*nxPerBlock+1 +! starts(2) = (jb-1)*nyPerBlock+1 +! +! call nc_put_variable(ncid, gitmvar(ivar)%varname, & +! data2d(1:nxPerBlock,1:nyPerBlock), & +! context=routine, nc_start=starts, & +! nc_count=(/nxPerBlock,nyPerBlock/)) +! end if +! +! end subroutine unpack_data2d !================================================================== -function read_model_time(filename) -type(time_type) :: read_model_time -character(len=*), intent(in) :: filename - -integer :: ncid, i, ios -integer :: tsimulation ! the time read from a restart file; seconds from aeth_ref_date. -integer :: ndays,nsecs - -character(len=*), parameter :: routine = 'read_model_time' - -tsimulation = MISSING_I - -ncid = open_block_file(filename, 'read') -call nc_get_variable(ncid, 'time', tsimulation, routine) -call nc_close_file(ncid, routine, filename) - -! Calculate the DART time of the file time. -! TODO: review calculation of ndays in read_model_time -ndays = tsimulation/86400 -nsecs = tsimulation - ndays*86400 -! Need to subtract 1 because the ref day is not finished. -ndays = aeth_ref_ndays -1 + ndays -read_model_time = set_time(nsecs,ndays) - -if (do_output()) & - call print_time(read_model_time,'read_model_time: time in restart file '//filename) -if (do_output()) & - call print_date(read_model_time,'read_model_time: date in restart file '//filename) - -if (debug > 8) then - write(string1,*)'tsimulation ',tsimulation - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'ndays ',ndays - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'nsecs ',nsecs - call error_handler(E_MSG,routine,string1,source,revision,revdate) - - call print_date( aeth_ref_time, 'read_model_time:model base date') - call print_time( aeth_ref_time, 'read_model_time:model base time') -endif - -end function read_model_time - - -!=============================================================================== -! Routines below here are private to the module -!=============================================================================== - -! Fill up the variable_table from the namelist item 'variables' -! The namelist item variables is where a user specifies -! which variables they want in the DART state: -! variable name, dart qty, clamping min, clamping max, origin file, update or not +! put the requested data into a netcdf variable -subroutine make_variable_table() +subroutine unpack_data(data3d, ivar, block, ncid) -integer :: nfields_constructed ! number of constructed state variables +real(r4), intent(in) :: data3d(1:nzPerBlock, & + 1-nGhost:nyPerBlock+nGhost, & + 1-nGhost:nxPerBlock+nGhost) -integer :: i, nrows, ncols +integer, intent(in) :: ivar ! variable index +integer, intent(in) :: block(2) +integer, intent(in) :: ncid +integer :: ib, jb +integer :: starts(3) +character(len=*), parameter :: routine = 'unpack_data' character(len=NF90_MAX_NAME) :: varname -character(len=NF90_MAX_NAME) :: dartstr -character(len=NF90_MAX_NAME) :: minvalstring -character(len=NF90_MAX_NAME) :: maxvalstring -character(len=NF90_MAX_NAME) :: filename -character(len=NF90_MAX_NAME) :: state_or_aux - -nrows = size(variable_table,1) ! these are MAX_NUM_VARIABLES, MAX_NUM_COLUMNS -ncols = size(variable_table,2) - -! Convert the (input) 1D array "variables" into a table with six columns. -! The number of rows in the table correspond to the number of variables in the -! DART state vector. -! Column 1 is the netCDF variable name. -! Column 2 is the corresponding DART kind. -! Column 3 is the minimum value ("NA" if there is none) Not Applicable -! Column 4 is the maximum value ("NA" if there is none) Not Applicable -! Column 5 is the file of origin aether restart 'neutrals' or 'ions' -! Column 6 is whether or not the variable should be updated in the restart file. - -nfields = 0 -! TODO: TIEGCM uses 3 domains. Aether may need only 1: -! Do we need the 3rd category for derived fields; TEC, ...? -nfields_neutral = 0 -nfields_ion = 0 -nfields_constructed = 0 - -ROWLOOP : do i = 1, nrows - - varname = trim(variables(ncols*i - 5)) - dartstr = trim(variables(ncols*i - 4)) - minvalstring = trim(variables(ncols*i - 3)) - maxvalstring = trim(variables(ncols*i - 2)) - filename = trim(variables(ncols*i - 1)) - state_or_aux = trim(variables(ncols*i )) -! TODO: should Aether use the 6th column of namelist variable input to handle TEC, ...? - call to_upper(state_or_aux) ! update or not - - variable_table(i,VT_VARNAMEINDX) = trim(varname) - variable_table(i,VT_KINDINDX) = trim(dartstr) - variable_table(i,VT_MINVALINDX) = trim(minvalstring) - variable_table(i,VT_MAXVALINDX) = trim(maxvalstring) - variable_table(i,VT_ORIGININDX) = trim(filename) - variable_table(i,VT_STATEINDX) = trim(state_or_aux) +print*,'unpack_data: data3d = ',data3d(1,1,1),data3d(15,15,15) - ! If the first element is empty, we have found the end of the list. - if ((variable_table(i,1) == ' ') ) exit ROWLOOP +write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) - ! Any other condition is an error. - if ( any(variable_table(i,:) == ' ') ) then - string1 = 'input.nml &model_nml:variables not fully specified.' - string2 = 'Must be 6 entries per variable, last known variable name is' - string3 = trim(variable_table(i,1)) - call error_handler(E_ERR,'get_variables_in_domain',string1, & - source,revision,revdate,text2=string2,text3=string3) - endif -! TODO; Modify this gitm error check for this routine? -! ! Make sure DART kind is valid -! -! 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 +ib = block(1) +jb = block(2) - nfields=nfields+1 - if (trim(variable_table(i,VT_ORIGININDX)) == 'neutrals') then - nfields_neutral = nfields_neutral+1 - else if (trim(variable_table(i,VT_ORIGININDX)) == 'ions') then - nfields_ion = nfields_ion+1 - else if (trim(variable_table(i,VT_ORIGININDX)) == 'CALCULATE') then - nfields_constructed = nfields_constructed + 1 - else - print*,'variable_table(',i, VT_ORIGININDX,') = ', trim(variable_table(i,VT_ORIGININDX)) - endif - print*,'make_variable_table: nfields = ',nfields, nfields_neutral, nfields_ion +! to compute the start, consider (ib-1)*nxPerBlock+1 +starts(1) = 1 +starts(2) = (jb-1)*nyPerBlock+1 +starts(3) = (ib-1)*nxPerBlock+1 -enddo ROWLOOP +call nc_put_variable(ncid, varname, & + data3d(1:nzPerBlock,1:nyPerBlock,1:nxPerBlock), & + context=routine, nc_start=starts, & + nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) +print*,'unpack_data: filled varname = ', varname -! Record the contents of the DART state vector -if (do_output() .and. (debug > 99)) then - do i = 1,nfields - write(*,'(''variable'',i4,'' is '',a12,1x,a32,4(1x,a20))') i, & - trim(variable_table(i,1)), & - trim(variable_table(i,2)), & - trim(variable_table(i,3)), & - trim(variable_table(i,4)), & - trim(variable_table(i,5)), & - trim(variable_table(i,6)) - write(logfileunit,'(''variable'',i4,'' is '',a12,1x,a32,4(1x,a20))') i, & - trim(variable_table(i,1)), & - trim(variable_table(i,2)), & - trim(variable_table(i,3)), & - trim(variable_table(i,4)), & - trim(variable_table(i,5)), & - trim(variable_table(i,6)) - enddo -endif +end subroutine unpack_data -! TODO: Aether may need something like this. -! if (estimate_f10_7) then -! if (nfields_constructed == 0) then -! call error_handler(E_ERR, 'expecting f10.7 in &model_nml::variables', source) -! endif -! call load_up_state_structure_from_file(f10_7_file_name, nfields_constructed, 'CALCULATE', CONSTRUCT_DOM) -! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) & -! + get_domain_size(CONSTRUCT_DOM) -! else -! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) -! endif -! -end subroutine make_variable_table !================================================================== ! From 9e80f4a1bcec772572654342e19457f6b07f9ee2 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Wed, 1 Nov 2023 14:17:34 -0600 Subject: [PATCH 050/124] Fixed quickbuild.sh to process only one _to_ file aether_to_dart and dart_to_aether need to be in the model_serial_programs list, not serial_programs. Otherwise, `quickbuild aether_to_dart` finds dart_to_aether.f90 and processes it like a module. --- guide/quickbuild.rst | 4 ++-- models/aether_lon-lat/work/quickbuild.sh | 19 +++++++++++-------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/guide/quickbuild.rst b/guide/quickbuild.rst index 04cc8678e9..47c59b97dc 100644 --- a/guide/quickbuild.rst +++ b/guide/quickbuild.rst @@ -68,7 +68,7 @@ For models there are four arrays in quickbuild.sh: ) serial_programs=( - DART programs that do not use mpi go here + DART programs that do not use mpi go here, but not model_to_dart, dart_to_model ) model_programs=( @@ -76,7 +76,7 @@ For models there are four arrays in quickbuild.sh: ) model_serial_programs=( - model programs that do not use mpi go here + model programs that do not use mpi go here, e.g. model_to_dart, dart_to_model ) For observation converters, there is a single array. diff --git a/models/aether_lon-lat/work/quickbuild.sh b/models/aether_lon-lat/work/quickbuild.sh index eece86e9c3..a329e655a7 100755 --- a/models/aether_lon-lat/work/quickbuild.sh +++ b/models/aether_lon-lat/work/quickbuild.sh @@ -13,18 +13,21 @@ MODEL=aether_lon-lat LOCATION=threed_sphere programs=( +filter +model_mod_check +perfect_model_obs ) -# filter -# model_mod_check -# perfect_model_obs serial_programs=( -aether_to_dart +create_fixed_network_seq +create_obs_sequence +obs_diag +obs_seq_to_netcdf ) -# create_fixed_network_seq -# create_obs_sequence -# obs_diag -# obs_seq_to_netcdf + +model_serial_programs=( +aether_to_dart +dart_to_aether) arguments "$@" From a96a517391d89bfb64cd0f8ba6d85c4c163de437 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 3 Nov 2023 19:55:51 -0600 Subject: [PATCH 051/124] Prepped for adding dart_to_aether routines. Changed aether_to_dart routine names to describe what they do. That clarifies how to write the dart_to_aether routines. --- models/aether_lon-lat/model_mod.f90 | 203 ++++++++++++++-------------- 1 file changed, 102 insertions(+), 101 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 63a4f291a4..2eb6336634 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -435,14 +435,14 @@ subroutine restart_files_to_netcdf(restart_dirname, member, netcdf_output_file) ! Enters and exits define mode; call nc_write_model_atts(ncid, 0) -call get_data(restart_dirname, ncid, member, define=.true.) +call restarts_to_filter(restart_dirname, ncid, member, define=.true.) ! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts ! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying ! the state vector field names and source. ! call add_nc_dimvars(ncid) -call get_data(restart_dirname, ncid, member, define=.false.) +call restarts_to_filter(restart_dirname, ncid, member, define=.false.) ! TODO: this needs to be updated to write to which file? ! call write_model_time(ncid, state_time) @@ -1723,86 +1723,87 @@ subroutine verify_block_variables( variable_array, ngood) end subroutine verify_block_variables !================================================================== - -subroutine add_nc_definitions(ncid) - -integer, intent(in) :: ncid - -call nc_add_global_attribute(ncid, 'model', 'aether') - -!------------------------------------------------------------------------------- -! Determine shape of most important namelist -!------------------------------------------------------------------------------- -! -!call find_textfile_dims('gitm_vars.nml', nlines, linelen) -!if (nlines > 0) then -! has_gitm_namelist = .true. -! -! allocate(textblock(nlines)) -! textblock = '' -! -! call nc_define_dimension(ncid, 'nlines', nlines) -! call nc_define_dimension(ncid, 'linelen', linelen) -! call nc_define_character_variable(ncid, 'gitm_in', (/ 'nlines ', 'linelen' /)) -! call nc_add_attribute_to_variable(ncid, 'gitm_in', 'long_name', 'contents of gitm_in namelist') -! -!else -! has_gitm_namelist = .false. -!endif -! -!---------------------------------------------------------------------------- -! output only grid info - state vars will be written by other non-model_mod code -!---------------------------------------------------------------------------- - -call nc_define_dimension(ncid, LON_DIM_NAME, nlon) -call nc_define_dimension(ncid, LAT_DIM_NAME, nlat) -call nc_define_dimension(ncid, ALT_DIM_NAME, nalt) -! TODO: is WL in Aether? No; remove from model_mod. -call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? - -!---------------------------------------------------------------------------- -! Create the (empty) Coordinate Variables and the Attributes -!---------------------------------------------------------------------------- - -! TODO: This defines more attributes than TIEGCM. Prefer? Are these accurate for Aether? -! Grid Longitudes -call nc_define_double_variable(ncid, LON_VAR_NAME, (/ LON_DIM_NAME /) ) -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'type', 'x1d') -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'long_name', 'grid longitudes') -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'cartesian_axis', 'X') -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'units', 'degrees_east') -call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'valid_range', (/ 0.0_r8, 360.0_r8 /) ) - -! Grid Latitudes -call nc_define_double_variable(ncid, LAT_VAR_NAME, (/ LAT_DIM_NAME /) ) -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'type', 'y1d') -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'long_name', 'grid latitudes') -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'cartesian_axis', 'Y') -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'units', 'degrees_north') -call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'valid_range', (/ -90.0_r8, 90.0_r8 /) ) - -! Grid Altitudes -call nc_define_double_variable(ncid, ALT_VAR_NAME, (/ ALT_DIM_NAME /) ) -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'type', 'z1d') -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'long_name', 'grid altitudes') -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'cartesian_axis', 'Z') -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'units', 'meters') -call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'positive', 'up') - -! Grid wavelengths -call nc_define_double_variable(ncid, 'WL', (/ 'WL' /) ) -call nc_add_attribute_to_variable(ncid, 'WL', 'type', 'x1d') -call nc_add_attribute_to_variable(ncid, 'WL', 'long_name', 'grid wavelengths') -call nc_add_attribute_to_variable(ncid, 'WL', 'cartesian_axis', 'X') -call nc_add_attribute_to_variable(ncid, 'WL', 'units', 'wavelength_index') -call nc_add_attribute_to_variable(ncid, 'WL', 'valid_range', (/ 0.9_r8, 38.1_r8 /) ) - -end subroutine add_nc_definitions - +! +! subroutine add_nc_definitions(ncid) +! +! integer, intent(in) :: ncid +! +! call nc_add_global_attribute(ncid, 'model', 'aether') +! +! !------------------------------------------------------------------------------- +! ! Determine shape of most important namelist +! !------------------------------------------------------------------------------- +! ! +! !call find_textfile_dims('gitm_vars.nml', nlines, linelen) +! !if (nlines > 0) then +! ! has_gitm_namelist = .true. +! ! +! ! allocate(textblock(nlines)) +! ! textblock = '' +! ! +! ! call nc_define_dimension(ncid, 'nlines', nlines) +! ! call nc_define_dimension(ncid, 'linelen', linelen) +! ! call nc_define_character_variable(ncid, 'gitm_in', (/ 'nlines ', 'linelen' /)) +! ! call nc_add_attribute_to_variable(ncid, 'gitm_in', 'long_name', 'contents of gitm_in namelist') +! ! +! !else +! ! has_gitm_namelist = .false. +! !endif +! ! +! !---------------------------------------------------------------------------- +! ! output only grid info - state vars will be written by other non-model_mod code +! !---------------------------------------------------------------------------- +! +! call nc_define_dimension(ncid, LON_DIM_NAME, nlon) +! call nc_define_dimension(ncid, LAT_DIM_NAME, nlat) +! call nc_define_dimension(ncid, ALT_DIM_NAME, nalt) +! ! TODO: is WL in Aether? No; remove from model_mod. +! call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? +! +! !---------------------------------------------------------------------------- +! ! Create the (empty) Coordinate Variables and the Attributes +! !---------------------------------------------------------------------------- +! +! ! TODO: This defines more attributes than TIEGCM. Prefer? Are these accurate for Aether? +! ! Grid Longitudes +! call nc_define_double_variable(ncid, LON_VAR_NAME, (/ LON_DIM_NAME /) ) +! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'type', 'x1d') +! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'long_name', 'grid longitudes') +! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'cartesian_axis', 'X') +! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'units', 'degrees_east') +! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'valid_range', (/ 0.0_r8, 360.0_r8 /) ) +! +! ! Grid Latitudes +! call nc_define_double_variable(ncid, LAT_VAR_NAME, (/ LAT_DIM_NAME /) ) +! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'type', 'y1d') +! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'long_name', 'grid latitudes') +! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'cartesian_axis', 'Y') +! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'units', 'degrees_north') +! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'valid_range', (/ -90.0_r8, 90.0_r8 /) ) +! +! ! Grid Altitudes +! call nc_define_double_variable(ncid, ALT_VAR_NAME, (/ ALT_DIM_NAME /) ) +! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'type', 'z1d') +! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'long_name', 'grid altitudes') +! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'cartesian_axis', 'Z') +! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'units', 'meters') +! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'positive', 'up') +! +! ! Grid wavelengths +! call nc_define_double_variable(ncid, 'WL', (/ 'WL' /) ) +! call nc_add_attribute_to_variable(ncid, 'WL', 'type', 'x1d') +! call nc_add_attribute_to_variable(ncid, 'WL', 'long_name', 'grid wavelengths') +! call nc_add_attribute_to_variable(ncid, 'WL', 'cartesian_axis', 'X') +! call nc_add_attribute_to_variable(ncid, 'WL', 'units', 'wavelength_index') +! call nc_add_attribute_to_variable(ncid, 'WL', 'valid_range', (/ 0.9_r8, 38.1_r8 /) ) +! +! end subroutine add_nc_definitions +! !================================================================= -! open all restart files and read in the requested data item +! open all restart files and transfer the requested data item +! to the filter input file. -subroutine get_data(dirname, ncid_output, member, define) +subroutine restarts_to_filter(dirname, ncid_output, member, define) character(len=*), intent(in) :: dirname integer, intent(in) :: ncid_output, member @@ -1816,41 +1817,41 @@ subroutine get_data(dirname, ncid_output, member, define) if (define) then ! if define, run one block. - ! the read_data_from_block call defines the variables in the whole domain netCDF file. + ! the block_to_filter_io call defines the variables in the whole domain netCDF file. ibLoop = 1 jbLoop = 1 call nc_begin_define_mode(ncid_output) else ! if not define, run all blocks. - ! the read_data_from_block call adds the (ib,jb) block to a netCDF variable + ! the block_to_filter_io call adds the (ib,jb) block to a netCDF variable ! in order to make a file containing the data for all the blocks. ibLoop = nBlocksLon jbLoop = nBlocksLat end if -print*,'get_data: define = ',define +print*,'restarts_to_filter: define = ',define do jb = 1, jbLoop do ib = 1, ibLoop - call read_data_from_block(ncid_output, dirname, ib, jb, member, define) + call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) enddo enddo if (define) call nc_end_define_mode(ncid_output) -end subroutine get_data +end subroutine restarts_to_filter !================================================================== -!> Open all restart files and read in the requested data items. -!> The unpack* calls will write the data to the filter_input.nc. +!> Open all restart files for a block and read in the requested data items. +!> The write_filter_io calls will write the data to the filter_input.nc. !> !> This is a two-pass method: first run through to define the NC variables !> in the filter_input.nc (define = .true.), !> then run again to write the data to the NC file(define = .false.) -subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) +subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) integer, intent(in) :: ncid_output character(len=*), intent(in) :: dirname @@ -1866,7 +1867,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) logical :: no_idensity -character(len=*), parameter :: routine = 'read_data_from_block' +character(len=*), parameter :: routine = 'block_to_filter_io' character(len=128) :: file_root character(len=256) :: filename character(len=NF90_MAX_NAME) :: varname @@ -1931,7 +1932,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) ! read(iunit) temp3d ! if (j <= inum) then ! if (i == gitmvar(ivals(j))%gitm_index) then -! call unpack_data(temp3d, ivals(j), block, ncid) +! call write_filter_io(temp3d, ivals(j), block, ncid) ! j = j + 1 ! endif ! endif @@ -1975,7 +1976,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) ! no_idensity = .false. ! end if ! ! read from input but write from state vector -! call unpack_data(temp3d, ivals(j), block, ncid) +! call write_filter_io(temp3d, ivals(j), block, ncid) ! j = j + 1 ! endif ! endif @@ -2000,7 +2001,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) filename = block_file_name(file_root, member, nb) ncid_input = open_block_file(trim(filename), 'read') -print*,'read_data_from_block: nfields_neutral = ',nfields_neutral +print*,'block_to_filter_io: nfields_neutral = ',nfields_neutral do ivar = 1, nfields_neutral write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) @@ -2033,9 +2034,9 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) ! Read 3D array and extract the non-halo data of this block. ! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. call nc_get_variable(ncid_input, varname, temp3d, routine) - print*,'read_data_from_block: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),variable_table(ivar,VT_VARNAMEINDX) - print*,'read_data_from_block: define = ',define - call unpack_data(temp3d, ivar, block, ncid_output) + print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),variable_table(ivar,VT_VARNAMEINDX) + print*,'block_to_filter_io: define = ',define + call write_filter_io(temp3d, ivar, block, ncid_output) else write(string1,*) 'Trying to read neutrals, but variable_table(',ivar,VT_ORIGININDX, & ') /= "neutrals"' @@ -2049,7 +2050,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) filename = block_file_name(file_root, member, nb) ncid_input = open_block_file(trim(filename), 'read') -print*,'read_data_from_block: nfields_ion = ',nfields_ion +print*,'block_to_filter_io: nfields_ion = ',nfields_ion do ivar = nfields_neutral +1,nfields_neutral + nfields_ion write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) @@ -2066,7 +2067,7 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) else if (file_root == 'ions') then call nc_get_variable(ncid_input, varname, temp3d, routine) - call unpack_data(temp3d, ivar, block, ncid_output) + call write_filter_io(temp3d, ivar, block, ncid_output) else write(string1,*) 'Trying to read ions, but variable_table(',ivar,VT_ORIGININDX, & ') /= "ions"' @@ -2111,14 +2112,14 @@ subroutine read_data_from_block(ncid_output, dirname, ib, jb, member, define) ! read(iunit) temp3d ! call get_index_from_gitm_varname('Rho', inum, ivals) ! if (inum > 0) then -! call unpack_data(temp3d, ivals(1), block, ncid) +! call write_filter_io(temp3d, ivals(1), block, ncid) ! endif !print *, 'calling dealloc' deallocate(temp1d, temp2d, temp3d) deallocate(alt1d, density_ion_e) -end subroutine read_data_from_block +end subroutine block_to_filter_io !================================================================== @@ -2215,7 +2216,7 @@ end subroutine read_data_from_block ! put the requested data into a netcdf variable -subroutine unpack_data(data3d, ivar, block, ncid) +subroutine write_filter_io(data3d, ivar, block, ncid) real(r4), intent(in) :: data3d(1:nzPerBlock, & 1-nGhost:nyPerBlock+nGhost, & @@ -2248,7 +2249,7 @@ subroutine unpack_data(data3d, ivar, block, ncid) nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) print*,'unpack_data: filled varname = ', varname -end subroutine unpack_data +end subroutine write_filter_io !================================================================== From dc2eb1ac2b606f887c69cdfa25bb6d1d6f11661f Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 7 Nov 2023 20:32:38 -0700 Subject: [PATCH 052/124] Added dart_to_aether program and routines. >>> It turns out that the halos at the poles are not copies of points from over the pole. There's an interpolation, which may need happen in dart_to_aether. Complete update of dart_to_aether.f90 from GITM version to Aether. Inverted the ivar and {ib,jb} loops: + read in a whole domain of a field from filter_output.nc, + add a halo around the whole thing, which contains updated state variables, + loop over the blocks to extract the data+halo for each and write to the block restart file. Renamed some routines to better describe what they do. It compiles and runs correctly (caveat the halo interpolation issue). If this is too much opening and closing restart files, open all block restart files at the start, and close after all vars are written. To be done, especially after getting restart file changes from Aaron: - Update dimension orders in arrays and NetCDF calls. - Update field names. - Add sections to handle TEC and f10_7. - Replace add_halo_fulldom3d poles sections with interpolations. - Remove remaining commented GITM code. --- models/aether_lon-lat/dart_to_aether.f90 | 137 ++---- models/aether_lon-lat/dart_to_aether.nml | 6 +- models/aether_lon-lat/model_mod.f90 | 563 +++++++++++++++++++++-- models/aether_lon-lat/work/input.nml | 10 +- 4 files changed, 575 insertions(+), 141 deletions(-) diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90 index 9879cf42d0..213015fd53 100644 --- a/models/aether_lon-lat/dart_to_aether.f90 +++ b/models/aether_lon-lat/dart_to_aether.f90 @@ -4,155 +4,104 @@ ! ! $Id$ -program netcdf_to_gitm_blocks +program dart_to_aether !---------------------------------------------------------------------- -! purpose: interface between DART and the GITM model +! purpose: interface between DART and the Aether model ! -! method: Read DART state netcdf files and overwrite values in a gitm restart file. +! method: Read DART state netcdf files and overwrite values in Aether restart files. ! -! this version assumes that the grid is global and the data needs to be -! blocked into one block per gitm mpi task. there is a different converter -! for when gitm only needs a single input/output file. +! this version assumes that the DART grid is global and the data needs to be +! blocked into one block per Aether mpi task. there is a different converter +! for when Aether only needs a single input/output file. ! !---------------------------------------------------------------------- -use types_mod, only : r8 - use utilities_mod, only : initialize_utilities, finalize_utilities, & find_namelist_in_file, check_namelist_read, & - open_file, close_file, E_MSG, error_handler + E_MSG, error_handler use model_mod, only : netcdf_to_restart_files -use time_manager_mod, only : time_type, print_time, print_date, operator(-), & - get_time, get_date +use time_manager_mod, only : operator(-) implicit none ! version controlled file description for error handling, do not edit -character(len=256), parameter :: source = & - "$URL$" +character(len=256), parameter :: source = "$URL$" character(len=32 ), parameter :: revision = "$Revision$" character(len=128), parameter :: revdate = "$Date$" -character(len=*), parameter :: progname = 'netcdf_to_gitm_blocks' +character(len=*), parameter :: progname = 'dart_to_aether' !----------------------------------------------------------------------- ! namelist parameters with default values. !----------------------------------------------------------------------- -character (len = 256) :: gitm_restart_input_dirname = 'none' -character (len = 256) :: gitm_restart_output_dirname = 'none' -character (len = 256) :: netcdf_to_gitm_blocks_input_file = 'filter_restart.nc' +character (len = 256) :: aether_restart_dirname = 'none' +character (len = 64) :: filter_io_root = 'filter_output' +character (len = 64) :: filter_io_name -namelist /netcdf_to_gitm_blocks_nml/ & - gitm_restart_input_dirname, & - gitm_restart_output_dirname, & - netcdf_to_gitm_blocks_input_file +namelist /dart_to_aether_nml/ & + aether_restart_dirname, & + filter_io_root !---------------------------------------------------------------------- ! global storage !---------------------------------------------------------------------- -integer :: iunit, io -character(len=512) :: string1, string2, string3 +integer :: iunit, io, member +character(len=512) :: string1, string2 + +!---------------------------------------------------------------------- +! Get the ensemble member +! TODO: The script must echo the member number to the dart_to_aether. +! There may be a mismatch between member numbers in DART and Aether; F or C indexing. +!---------------------------------------------------------------------- +member = -88 +read '(I3)', member +print*,'dart_to_aether: member = ',member + +write(filter_io_name,'(2A,I0.4,A3)') trim(filter_io_root),'_',member,'.nc' !====================================================================== call initialize_utilities(progname=progname) !---------------------------------------------------------------------- -! Read the namelist. +! Read the namelist !---------------------------------------------------------------------- -call find_namelist_in_file("input.nml", "netcdf_to_gitm_blocks_nml", iunit) -read(iunit, nml = netcdf_to_gitm_blocks_nml, iostat = io) -call check_namelist_read(iunit, io, "netcdf_to_gitm_blocks_nml") +call find_namelist_in_file("input.nml", "dart_to_aether_nml", iunit) +read(iunit, nml = dart_to_aether_nml, iostat = io) +call check_namelist_read(iunit, io, "dart_to_aether_nml") ! closes, too. + +print*,'After namelist; aether_restart_dirname = ',aether_restart_dirname call error_handler(E_MSG,progname,'','',revision,revdate) -write(string1,*) 'converting DART file ', "'"//trim(netcdf_to_gitm_blocks_input_file)//"'" -write(string2,*) 'to gitm restart files in directory ', "'"//trim(gitm_restart_output_dirname)//"'" -write(string3,*) 'using the restart files in directory ', "'"//trim(gitm_restart_input_dirname)//"' as a template" -call error_handler(E_MSG,progname,string1,source,revision,revdate,text2=string2,text3=string3) +write(string1,*) 'Extracting fields from DART file ', "'"//trim(filter_io_name)//"'" +write(string2,*) 'into Aether restart files in directory ', "'"//trim(aether_restart_dirname)//"'" +call error_handler(E_MSG,progname,string1,source,revision,revdate,text2=string2) !---------------------------------------------------------------------- ! Reads the valid time, the state, and the target time. !---------------------------------------------------------------------- -call netcdf_to_restart_files(netcdf_to_gitm_blocks_input_file,gitm_restart_output_dirname,& - gitm_restart_input_dirname) +! TODO: netcdf_to_restart_files; need all these file and dir names? +call netcdf_to_restart_files(filter_io_name, member, aether_restart_dirname) !---------------------------------------------------------------------- ! Log what we think we're doing, and exit. !---------------------------------------------------------------------- call error_handler(E_MSG,progname,'','',revision,revdate) -call error_handler(E_MSG,progname,'','',revision,revdate) -write(string1,*) 'Successfully converted to the gitm restart files in directory' -write(string2,*) "'"//trim(gitm_restart_output_dirname)//"'" +write(string1,*) 'Successfully converted to the Aether restart files in directory' +write(string2,*) "'"//trim(aether_restart_dirname)//"'" call error_handler(E_MSG,progname,string1,source,revision,revdate,text2=string2) ! end - close the log, etc call finalize_utilities() -!====================================================================== -contains -!====================================================================== - -subroutine write_gitm_time_control(model_time, adv_to_time) -! The idea is to write a text file with the following structure: -! -!#TIMESTART -!2003 year -!06 month -!21 day -!00 hour -!00 minute -!00 second -! -!#TIMEEND -!2003 year -!07 month -!21 day -!00 hour -!00 minute -!00 second -! - -type(time_type), intent(in) :: model_time, adv_to_time -integer :: iyear,imonth,iday,ihour,imin,isec - -iunit = open_file('DART_GITM_time_control.txt', action='write') -write(iunit,*) - -! the end time comes first. - -call get_date(adv_to_time,iyear,imonth,iday,ihour,imin,isec) -write(iunit,'(''#TIMEEND'')') -write(iunit,'(i4.4,10x,''year'' )')iyear -write(iunit,'(i2.2,12x,''month'' )')imonth -write(iunit,'(i2.2,12x,''day'' )')iday -write(iunit,'(i2.2,12x,''hour'' )')ihour -write(iunit,'(i2.2,12x,''minute'')')imin -write(iunit,'(i2.2,12x,''second'')')isec -write(iunit,*) - -call get_date(model_time,iyear,imonth,iday,ihour,imin,isec) -write(iunit,'(''#TIMESTART'')') -write(iunit,'(i4.4,10x,''year'' )')iyear -write(iunit,'(i2.2,12x,''month'' )')imonth -write(iunit,'(i2.2,12x,''day'' )')iday -write(iunit,'(i2.2,12x,''hour'' )')ihour -write(iunit,'(i2.2,12x,''minute'')')imin -write(iunit,'(i2.2,12x,''second'')')isec -write(iunit,*) - -call close_file(iunit) -end subroutine write_gitm_time_control - - - -end program netcdf_to_gitm_blocks +end program dart_to_aether ! ! $URL$ diff --git a/models/aether_lon-lat/dart_to_aether.nml b/models/aether_lon-lat/dart_to_aether.nml index 7e47acd4d5..dd90fcaf3f 100644 --- a/models/aether_lon-lat/dart_to_aether.nml +++ b/models/aether_lon-lat/dart_to_aether.nml @@ -1,4 +1,6 @@ -&netcdf_to_gitm_blocks_nml - netcdf_to_gitm_blocks_input_file = 'filter_output.nc', +&dart_to_aether_nml + aether_restart_dirname = /Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member + filter_io_root = 'filter_output', / +! 4 digit member number and .nc will be appended to this. diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 2eb6336634..2748442067 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -92,7 +92,7 @@ module model_mod nc_add_global_creation_time, nc_begin_define_mode, & nc_define_dimension, nc_end_define_mode, & nc_put_variable,nc_add_attribute_to_variable, & - nc_define_real_variable, & + nc_define_real_variable, nc_open_file_readwrite, & nc_check, nc_open_file_readonly, nc_get_dimension_size, & nc_close_file, nc_get_variable, & nc_get_dimension_size, nc_create_file, & @@ -132,6 +132,7 @@ module model_mod ! block_file_name creates an Aether restart file name, ! which is useful for read_model_time calls, and others. public :: restart_files_to_netcdf, & + netcdf_to_restart_files, & block_file_name ! version controlled file description for error handling, do not edit @@ -250,6 +251,7 @@ module model_mod ! the number of blocks comes from UAM.in ! nzPerBlock is the number of altitudes, which does not depend on block ! nGhost is the halo region width in the block(subdomain) files. +! TODO: change nGhost to nhalo? ! TODO: n[xyz]PerBlock should probably come from a namelist (aether_to_dart.nml; ! can that be used for dart_to_aether?) @@ -409,10 +411,11 @@ end function block_file_name !> is orthogonal and rectangular but can have irregular spacing along !> any or all of the three dimensions. -subroutine restart_files_to_netcdf(restart_dirname, member, netcdf_output_file) +subroutine restart_files_to_netcdf(restart_dirname, member, filter_io_file) +! TODO: Does restart_files_to_netcdf need restart_dir? character(len=*), intent(in) :: restart_dirname -character(len=*), intent(in) :: netcdf_output_file +character(len=*), intent(in) :: filter_io_file integer, intent(in) :: member integer :: ncid @@ -427,7 +430,7 @@ subroutine restart_files_to_netcdf(restart_dirname, member, netcdf_output_file) call static_init_blocks(restart_dirname) -ncid = nc_create_file(netcdf_output_file) +ncid = nc_create_file(filter_io_file) ! DONE: This should probably be replaced by nc_write_model_atts(ncid). ! That may require renaming some dimension variables. @@ -451,6 +454,41 @@ subroutine restart_files_to_netcdf(restart_dirname, member, netcdf_output_file) end subroutine restart_files_to_netcdf +!================================================================= +! Writes the current time and state variables from a dart state +! vector (1d array) into a gitm netcdf restart file. + +subroutine netcdf_to_restart_files(nc_file, member, output_dirname) + +character(len=*), intent(in) :: nc_file +character(len=*), intent(in) :: output_dirname +integer, intent(in) :: member + +integer :: ncid + +character(len=*), parameter :: routine = 'netcdf_to_restart_files:' + +! sort the required fields into the order they exist in the +! binary restart files and write out the state vector data +! field by field. when this routine returns all the data has +! been written. + +if (module_initialized ) then + write(string1,*)'The gitm mod was already initialized but ',trim(routine),& + ' uses a separate initialization procedure' + call error_handler(E_ERR,routine,string1,source,revision,revdate) +end if + +call static_init_blocks(output_dirname) + +ncid = nc_open_file_readonly(nc_file, routine) + +call filter_to_restarts(output_dirname, ncid, member) + +call nc_close_file(ncid) + +end subroutine netcdf_to_restart_files + !================================================================= function get_model_size() @@ -1005,7 +1043,7 @@ function read_model_time(filename) tsimulation = MISSING_I ncid = open_block_file(filename, 'read') -call nc_get_variable(ncid, 'time', tsimulation, routine) +call nc_get_variable(ncid, 'time', tsimulation, context=routine) call nc_close_file(ncid, routine, filename) ! Calculate the DART time of the file time. @@ -1039,6 +1077,8 @@ end function read_model_time !=============================================================================== ! Routines below here are private to the module !=============================================================================== +! Routines for initialization. +!================================================================== ! Fill up the variable_table from the namelist item 'variables' ! The namelist item variables is where a user specifies @@ -1181,9 +1221,9 @@ subroutine get_grid_from_netcdf(filter_io_filename, lons, lats, alts ) ncid = nc_open_file_readonly(filter_io_filename, routine) -call nc_get_variable(ncid, LON_VAR_NAME, lons, routine) -call nc_get_variable(ncid, LAT_VAR_NAME, lats, routine) -call nc_get_variable(ncid, ALT_VAR_NAME, alts, routine) +call nc_get_variable(ncid, LON_VAR_NAME, lons, context=routine) +call nc_get_variable(ncid, LAT_VAR_NAME, lats, context=routine) +call nc_get_variable(ncid, ALT_VAR_NAME, alts, context=routine) call nc_close_file(ncid) @@ -1466,6 +1506,8 @@ function read_in_real(iunit,varname,filename) end function read_in_real !================================================================= +! Routines for aether_to_dart. +!================================================================== ! open enough of the restart files to read in the lon, lat, alt arrays @@ -1556,25 +1598,18 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & ! go across the south-most block row picking up all longitudes do nb = 1, nBlocksLon + ! filename is trimmed by passage to open_block_file + "len=*" there. filename = block_file_name('grid', -1, nb-1) - ncid = open_block_file(trim(filename), 'read') + ncid = open_block_file(filename, 'read') ! Read 3D array and extract the longitudes of the non-halo data of this block. -! This gets nc_get_double_3d, even though the fields are float. -!? Is there some environment setting that says float = double? -! ERROR This yields Start+count exceeds dimension bound -! call nc_get_variable(ncid, 'Longitude', temp, routine) -! ERROR: this yields Index exceeds dimension bound ! The restart files have C-indexing (fastest changing dim is the last), ! So invert the dimension bounds. call nc_get_variable(ncid, 'Longitude', & temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - routine, & + context=routine, & nc_count=(/zcount,ycount,xcount/)) -! Shouldn't need to specify default values nc_start=(/1,1,1/), & -! temp(1:zcount,1:ycount,1:xcount), & -! nc_start=(/starts(1),starts(2),starts(3)/), & ! TODO: nc_get_variable stops on error conditions, does not pass back ios. ! if ( ios /= 0 ) then ! print *,'size:',size(temp(1-nGhost:nxPerBlock+nGhost)) @@ -1598,11 +1633,11 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & ! any lon=const column. nboff = ((nb - 1) * nBlocksLon) filename = block_file_name('grid', -1, nboff) - ncid = open_block_file(trim(filename), 'read') + ncid = open_block_file(filename, 'read') call nc_get_variable(ncid, 'Latitude', & temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - routine, nc_count=(/zcount,ycount,xcount/)) + context=routine, nc_count=(/zcount,ycount,xcount/)) ! if ( ios /= 0 ) then ! write(string1,*)'ERROR reading file ', trim(filename) @@ -1623,12 +1658,12 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & ! if this is not the case, this code has to change. filename = block_file_name('grid', -1, 0) -ncid = open_block_file(trim(filename), 'read') +ncid = open_block_file(filename, 'read') temp = MISSING_R8 call nc_get_variable(ncid, 'Altitude', & temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - routine, nc_count=(/zcount,ycount,xcount/)) + context=routine, nc_count=(/zcount,ycount,xcount/)) alts(1:nzPerBlock) = temp(1:nzPerBlock,1,1) ! print*,'temp = ',temp(:,1,1) @@ -1665,23 +1700,33 @@ end subroutine get_grid_from_blocks function open_block_file(filename,rw) +! filename is trimmed by this definition character(len=*), intent(in) :: filename character(len=*), intent(in) :: rw ! 'read' or 'readwrite' integer :: open_block_file character(len=*), parameter :: routine = 'open_block_file' -if ( rw == 'read' .and. .not. file_exist(trim(filename)) ) then - write(string1,*) 'cannot open file ', trim(filename),' for reading.' - call error_handler(E_ERR,'open_block_file',string1,source,revision,revdate) +if ( .not. file_exist(filename) ) then + write(string1,*) 'cannot open file ', filename,' for ',rw + call error_handler(E_ERR,routine,string1,source,revision,revdate) endif if (debug > 0) then - write(string1,*) 'Opening file ', trim(filename), ' for ', trim(rw) + write(string1,*) 'Opening file ', trim(filename), ' for ', rw call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) end if -open_block_file = nc_open_file_readonly(trim(filename), routine) + +if (rw == 'read') then + open_block_file = nc_open_file_readonly(filename, routine) +else if (rw == 'readwrite') then + open_block_file = nc_open_file_readwrite(filename, routine) +else + string1 = ': must be called with rw={read,readwrite}, not '//rw + call error_handler(E_ERR,'open_block_file',string1,source,revision,revdate) +endif + if (debug > 80) then write(string1,*) 'Returned file descriptor is ', open_block_file @@ -1999,7 +2044,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) file_root = variable_table(1,VT_ORIGININDX) filename = block_file_name(file_root, member, nb) -ncid_input = open_block_file(trim(filename), 'read') +ncid_input = open_block_file(filename, 'read') print*,'block_to_filter_io: nfields_neutral = ',nfields_neutral do ivar = 1, nfields_neutral @@ -2033,7 +2078,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) else if (file_root == 'neutrals') then ! Read 3D array and extract the non-halo data of this block. ! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. - call nc_get_variable(ncid_input, varname, temp3d, routine) + call nc_get_variable(ncid_input, varname, temp3d, context=routine) print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),variable_table(ivar,VT_VARNAMEINDX) print*,'block_to_filter_io: define = ',define call write_filter_io(temp3d, ivar, block, ncid_output) @@ -2048,7 +2093,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) file_root = variable_table(nfields_neutral+1,VT_ORIGININDX) filename = block_file_name(file_root, member, nb) -ncid_input = open_block_file(trim(filename), 'read') +ncid_input = open_block_file(filename, 'read') print*,'block_to_filter_io: nfields_ion = ',nfields_ion do ivar = nfields_neutral +1,nfields_neutral + nfields_ion @@ -2066,7 +2111,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) print*,routine,': defined ivar, varname = ', ivar, varname else if (file_root == 'ions') then - call nc_get_variable(ncid_input, varname, temp3d, routine) + call nc_get_variable(ncid_input, varname, temp3d, context=routine) call write_filter_io(temp3d, ivar, block, ncid_output) else write(string1,*) 'Trying to read ions, but variable_table(',ivar,VT_ORIGININDX, & @@ -2098,7 +2143,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! ! convert temp2d to TEC units ! temp2d = temp2d/1e16_r8 ! end if -! call unpack_data2d(temp2d, ivals(1), block, ncid, define) +! call write_block_to_filter2d(temp2d, ivals(1), block, ncid, define) ! end if ! TODO: Does Aether need f10_7 to be calculated or processed? Yes @@ -2106,13 +2151,13 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') ! call get_index_from_gitm_varname('f107', inum, ivals) ! if (inum > 0) then -! call unpack_data0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine +! call write_block_to_filter0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine ! endif ! ! read(iunit) temp3d ! call get_index_from_gitm_varname('Rho', inum, ivals) ! if (inum > 0) then -! call write_filter_io(temp3d, ivals(1), block, ncid) +! call write_block_to_filter(temp3d, ivals(1), block, ncid, define) ! endif !print *, 'calling dealloc' @@ -2131,7 +2176,7 @@ end subroutine block_to_filter_io ! !> f107 values from all other blocks (hopefully they are the same). ! !> written by alex ! -! subroutine unpack_data0d(data0d, ivar, ncid, define) +! subroutine write_block_to_filter0d(data0d, ivar, ncid, define) ! ! real(r8), intent(in) :: data0d ! integer, intent(in) :: ivar ! index into state structure @@ -2139,7 +2184,7 @@ end subroutine block_to_filter_io ! logical, intent(in) :: define ! ! -! character(len=*), parameter :: routine = 'unpack_data0d' +! character(len=*), parameter :: routine = 'write_block_to_filter0d' ! ! if (define) then ! @@ -2161,13 +2206,13 @@ end subroutine block_to_filter_io ! ! end if ! -! end subroutine unpack_data0d +! end subroutine write_block_to_filter0d ! ! !================================================================== ! ! ! put the requested data into a netcdf variable ! -! subroutine unpack_data2d(data2d, ivar, block, ncid, define) +! subroutine write_block_to_filter2d(data2d, ivar, block, ncid, define) ! ! real(r8), intent(in) :: data2d(1-nGhost:nxPerBlock+nGhost, & ! 1-nGhost:nyPerBlock+nGhost) @@ -2179,7 +2224,7 @@ end subroutine block_to_filter_io ! ! integer :: ib, jb ! integer :: starts(2) -! character(len=*), parameter :: routine = 'unpack_data2d' +! character(len=*), parameter :: routine = 'write_block_to_filter2d' ! ! if (define) then ! @@ -2210,7 +2255,7 @@ end subroutine block_to_filter_io ! nc_count=(/nxPerBlock,nyPerBlock/)) ! end if ! -! end subroutine unpack_data2d +! end subroutine write_block_to_filter2d !================================================================== @@ -2228,10 +2273,10 @@ subroutine write_filter_io(data3d, ivar, block, ncid) integer :: ib, jb integer :: starts(3) -character(len=*), parameter :: routine = 'unpack_data' +character(len=*), parameter :: routine = 'write_filter_io' character(len=NF90_MAX_NAME) :: varname -print*,'unpack_data: data3d = ',data3d(1,1,1),data3d(15,15,15) +print*,routine,': data3d = ',data3d(1,1,1),data3d(15,15,15) write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) @@ -2247,10 +2292,442 @@ subroutine write_filter_io(data3d, ivar, block, ncid) data3d(1:nzPerBlock,1:nyPerBlock,1:nxPerBlock), & context=routine, nc_start=starts, & nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) -print*,'unpack_data: filled varname = ', varname +print*,routine,': filled varname = ', varname end subroutine write_filter_io +!================================================================== +! Routines for dart_to_aether. +!================================================================== + +! open all restart files and write out the requested data item + +subroutine filter_to_restarts(dirnameout, ncid, member) +! TODO: Does filter_to_restarts need dirname and dirnameout? + +character(len=*), intent(in) :: dirnameout +integer, intent(in) :: member, ncid + +real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) +character(len=256) :: file_root +integer :: ivar + +character(len=NF90_MAX_NAME):: varname +character(len=*), parameter :: routine = 'filter_to_restarts' + +! Space for full domain field (read from filter_output.nc) +! and halo around the full domain +allocate(fulldom3d(1:nalt, & + 1-nGhost:nlat+nGhost, & + 1-nGhost:nlon+nGhost)) + +! get the dirname, construct the filenames inside open_block_file + + +do ivar = 1, nfields_neutral + varname = trim(variable_table(ivar,VT_VARNAMEINDX)) + print*,routine,': How long is varname after assignment with trim? ',varname,' end' + file_root = trim(variable_table(ivar,VT_ORIGININDX)) + + if (file_root == 'neutrals') then + fulldom3d = MISSING_R4 + call nc_get_variable(ncid, varname, fulldom3d(1:nalt,1:nlat,1:nlon), & + nc_count=(/nalt,nlat,nlon/),context=routine) + !? ncount not needed? Reading the whole field. + + ! Copy updated field values to full domain halo. + ! Block domains+halos will be easily read from this. + call add_halo_fulldom3d(fulldom3d) + + call filter_io_to_blocks(fulldom3d, varname, file_root, member) + else + ! TODO: error; varname is inconsistent with VT_ORIGININDX + endif + +enddo + +do ivar = nfields_neutral+1, nfields_neutral + nfields_ion + varname = trim(variable_table(ivar,VT_VARNAMEINDX)) + file_root = trim(variable_table(ivar,VT_ORIGININDX)) + print*,routine,': varname, fileroot = ',varname, fileroot + + if (file_root == 'ions') then + call nc_get_variable(ncid, varname, fulldom3d(1:nalt,1:nlat,1:nlon), & + nc_count=(/nalt,nlat,nlon/),context=routine) + !? ncount not needed? Reading the whole field. + + ! Copy updated field values to full domain halo. + ! Block domains+halos will be easily read from this. + call add_halo_fulldom3d(fulldom3d) + + call filter_io_to_blocks(fulldom3d, varname, file_root, member) + + else + ! TODO: error; varname is inconsistent with VT_ORIGININDX + endif +enddo + +deallocate(fulldom3d) +!, fulldom1d + +end subroutine filter_to_restarts + +!================================================================== + +subroutine add_halo_fulldom3d(fulldom3d) + +! Space for full domain field (read from filter_output.nc) +! and halo around the full domain +real(r4), intent(inout) :: fulldom3d(1:nzPerBlock, & + 1-nGhost:nlat+nGhost, & + 1-nGhost:nlon+nGhost) + +character(len=*), parameter :: routine = 'add_halo_fulldom3d' +integer :: g, i,j, haflat,haflon +real(r4), allocatable :: normed(:,:) +character(len=16) :: debug_format + +! An array for debugging by renormalizing an altitude of fulldom3d. +allocate(normed(1-nGhost:nlat+nGhost, & + 1-nGhost:nlon+nGhost)) + +haflat = nlat/2 +haflon = nlon/2 + +TODO: this is incorrect. Some sort of interpolation is done, instead of copying values. + Email from Aaron should point the way. + +do g = 1,nGhost + ! left; reach around the date line. + ! There's no data at the ends of the halos for this copy. + fulldom3d (:,1:nlat, 1-g) & + = fulldom3d(:,1:nlat,nlon+1-g) + + ! right + fulldom3d (:,1:nlat,nlon+g) & + = fulldom3d(:,1:nlat,g) + + ! bottom; reach over the S Pole for halo values. + ! There is data at the ends of the halos for these.) + + fulldom3d (:,1-g ,1-nGhost :haflon) & + = fulldom3d(:, g ,1-nGhost+haflon:nlon) + fulldom3d (:,1-g ,haflon+1:nlon) & + = fulldom3d(:, g ,1 :haflon) + ! Last 2 (halo) points on the right edge (at the bottom) + fulldom3d (:,1-g , nlon+1: nlon+nGhost) & + = fulldom3d(:, g ,haflon+1:haflon+nGhost) + + ! top + fulldom3d (:,nlat +g ,1-nGhost :haflon) & + = fulldom3d(:,nlat+1-g ,1-nGhost+haflon:nlon) + fulldom3d (:,nlat +g ,haflon+1:nlon) & + = fulldom3d(:,nlat+1-g ,1 :haflon) + ! Last 2 (halo) points on the right edge (at the top) + fulldom3d (:,nlat +g , nlon+1: nlon+nGhost) & + = fulldom3d(:,nlat+1-g ,haflon+1:haflon+nGhost) +enddo + +if (any(fulldom3d == MISSING_R4)) then + string1 = 'ERROR: some fulldom3d contain MISSING_R4 after halos' + call error_handler(E_ERR,routine,string1,source,revision,revdate) +endif + +! TODO: Keep halo corners check for future use? +! Then add debug conditional . Also, more robust rescaling. +! Debug; print the 4x4 arrays (corners & middle) +! to see whether values are copied correctly +! Level 44 values range from 800-eps to 805. I don't want to see the 80. +! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. +if (fulldom3d(44,10,10) > 1.e+10) then + normed = fulldom3d(44,:,:) - 1.1092e+10 + debug_format = '(3(4E10.4,2X))' +else if (fulldom3d(44,10,10) < 1000._r4) then + normed = fulldom3d(44,:,:) - 800._r4 + debug_format = '(3(4F10.5,2X))' +endif + +! Debug HDF5 +print*,'normed_field(10,nlat+1,nlon+2) = ',normed(nlat+1,nlon+2) + +! 17 format debug_format +print*,'top' +do j = nlat+2,nlat-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) +enddo +print*,'middle' +do j = haflat+2,haflat-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) +enddo +print*,'bottom' +do j = 2,-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) +enddo + +deallocate(normed) + +end subroutine add_halo_fulldom3d + +!================================================================== + +! Transfer part of the full field into a block restart file. + +subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) + +real(r4), intent(in) :: fulldom3d(1:nzPerBlock, & + 1-nGhost:nlat+nGhost, & + 1-nGhost:nlon+nGhost) +character(len=*), intent(in) :: varname +character(len=*), intent(in) :: file_root +integer, intent(in) :: member + +! Don't collect velocity components (6 of them) +! real(r4) :: temp0d +! , temp1d(:) ? +! , temp4d(:,:,:,:), +integer :: ncid_output +integer :: ib, jb, nb +integer :: starts(3),ends(3), xcount, ycount, zcount +character(len=256) :: block_file +character(len=*), parameter :: routine = 'filter_io_to_blocks' + +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +! allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) + + +print*,routine,'; How long is varname after passing to a subroutine? ',varname,' end' + +zcount = nzPerBlock +ycount = nyPerBlock + 2*nGhost +xcount = nxPerBlock + 2*nGhost + +! temp array large enough to hold velocity vect, etc +! TODO: Aether has 6 velocity components, but we're treating them +! as unrelated fields for reading and writing (for now). +! maxsize = max(3, nSpecies) +! allocate(temp4d(1-nGhost:nxPerBlock+nGhost, 1-nGhost:nyPerBlock+nGhost, & +! 1-nGhost:nzPerBlock+nGhost, maxsize)) + +if (debug > 0) then + write(string1,'(A,I0,A,I0,A)') 'Now putting the data for ',nBlocksLon, & + ' blocks lon by ',nBlocksLat,' blocks lat' + call error_handler(E_MSG,routine,string1,source,revision,revdate) +end if + +starts(3) = 1 +ends(3) = nzPerBlock + +do jb = 1, nBlocksLat + starts(2) = (jb-1)*nyPerBlock - nGhost + 1 + ends(2) = jb *nyPerBlock + nGhost + + do ib = 1, nBlocksLon + starts(1) = (ib-1)*nxPerBlock - nGhost + 1 + ends(1) = ib *nxPerBlock + nGhost + + nb = (jb-1) * nBlocksLon + ib - 1 + + block_file = block_file_name(trim(file_root), member, nb) + ncid_output = open_block_file(block_file, 'readwrite') + + ! TODO: error checking; does the block file have the field in it? + + print*,' ' + print*,'block, ib, jb = ',nb, ib, jb + print*,'starts = ',starts + print*,'ends = ',ends + print*,'counts = ',xcount,ycount,zcount + + + call nc_put_variable(ncid_output, trim(varname), & + fulldom3d(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & + context=routine, nc_count=(/zcount,ycount,xcount/) ) + + call nc_close_file(ncid_output) + + enddo +enddo + +! !print *, 'reading in temp4d for ivel' +! read(iunit) temp4d(:,:,:,1:3) +! call get_index_from_gitm_varname('IVelocity', inum, ivals) +! if (inum > 0) then +! ! one or more items in the state vector need to replace the +! ! data in the output file. loop over the index list in order. +! j = 1 +! do i = 1, 3 +! if (j <= inum) then +! if (i == gitmvar(ivals(j))%gitm_index) then +! print *,'now writing:',trim(gitmvar(ivals(j))%varname) +! ! read from input but write from state vector +! data3d = temp4d(:,:,:,i) +! call read_filter_io_block(ncid, ivals(j), block, data3d) +! temp4d(:,:,:,i) = data3d +! j = j + 1 +! endif +! endif +! enddo +! endif +! write(ounit) temp4d(:,:,:,1:3) +! +! !alex begin: added f107 and Rho to the restart files: +! read(iunit) temp0d +! data0d = temp0d +! call get_index_from_gitm_varname('f107', inum, ivals) +! if (inum > 0) then +! call read_filter_io_block0d(ncid, ivals(1), data0d) +! if (data0d < 0.0_r8) data0d = 60.0_r8 !alex +! write(ounit) data0d +! else +! write(ounit) temp0d +! endif + +end subroutine filter_io_to_blocks + +!================================================================== + +! put the state vector data into a 3d array + +subroutine read_filter_io_block(ncid, ivar, block, data3d) + +integer, intent(in) :: ncid +integer, intent(in) :: ivar ! index into state structure +integer, intent(in) :: block(2) +real(r8), intent(inout) :: data3d(1:nzPerBlock, & + 1-nGhost:nxPerBlock+nGhost, & + 1-nGhost:nyPerblock+nGhost) +integer :: ib, jb +integer :: starts(3) +integer :: ends(3) +integer :: local_starts(3) +integer :: local_ends(3) +integer :: counts(3) +integer :: maxvals(3) +integer :: i, j + +character(len=*), parameter :: routine = 'read_filter_io_block' +character(len=NF90_MAX_NAME) :: varname + +write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + +ib = block(1) +jb = block(2) + +! to compute the start, consider (ib-1)*nxPerBlock+1 +starts(1) = (ib-1)*nxPerBlock + 1 - nGhost + ends(1) = ib*nxPerBlock + nGhost +starts(2) = (jb-1)*nyPerBlock + 1 - nGhost + ends(2) = jb*nyPerBlock + nGhost +starts(3) = 0 + 1 + ends(3) = nzPerBlock + +maxvals = (/nlon,nlat,nalt/) + +! KDR It looks like blocks bordering the dateline do not have halos on the dateline edge. +do i=1,2 + if (starts(i) < 1) then + starts(i) = 1 + local_starts(i) = 1 + else + local_starts(i) = 1-nGhost + end if +end do +local_starts(3) = 1 + +do i=1,3 + if (ends(i) > maxvals(i)) then + ends(i) = maxvals(i) + end if +end do + +counts = ends-starts+1 + +local_ends = local_starts + counts - 1 + +if (debug > 10) then + if (ivar == 1) then + write(string1,'(12(A,I0),A)') 'Now reading netCDF indices (',starts(1),':',ends(1),') and (',starts(2),':',ends(2),') ' // & + 'in the block (',ib,',',jb,') for local (',local_starts(1),':',local_ends(1),') and (',& + local_starts(2),':',local_ends(2),') for size (',counts(1),',',counts(2),')' + call error_handler(E_MSG,routine,string1,source,revision,revdate) + end if +end if + +if (debug > 200) then + ! KDR; in GITM this assumed this is being called to "pack" the dimensions + ! and the user wanted to see level 3 of ivar=3 (Altitude) (?). + ! This is upgraded to explicitly check for the variable name. + ! Untested. + if (varname == 'Altitude') then + print *,'before reading:' + do i=1-nGhost,nxPerBlock+nGhost + do j=1-nGhost,nyPerBlock+nGhost + write(*,'(A,A,I0,A,I0,A,F8.3)') trim(varname), & + ' at level 3 (',i,',',j,'): ',data3D(3,j,i) + end do + end do + end if +end if + +! KDR starts and ends include the halo. +! Halos were not written explicitly to the DART netcdf file +! but the data is there; a complete state vector, +! so we can grab halos and central subdomains from it. +call nc_get_variable(ncid, varname, & + data3d(local_starts(3):local_ends(3), & + local_starts(2):local_ends(2), & + local_starts(1):local_ends(1)), & + context="read_filter_io_block", nc_start=starts, nc_count=counts) + +if (debug > 200) then + if (varname == 'Altitude') then + print *,'after reading:' + do i=1-nGhost,nxPerBlock+nGhost + do j=1-nGhost,nyPerBlock+nGhost + write(*,'(A,A,I0,A,I0,A,F8.3)') trim(varname), & + ' at level 3 (',i,',',j,'): ',data3D(3,j,i) + end do + end do + end if +end if + +end subroutine read_filter_io_block + + +!================================================================== + +!> put the f107 estimate (scalar) from the statevector into a 0d container +!> the only trick this routine does is give all blocks the same f107 (the +!> f107 value from block 1 state vector goes to block 1,2,3,4 restart files) +!> so no matter what, always grab the f107 from block 1 (manipulate +!> the block variable). +!> written by alex + +subroutine read_filter_io_block0d(ncid, ivar, data0d) + +integer, intent(in) :: ncid +integer, intent(in) :: ivar ! index into state structure +real(r8), intent(inout) :: data0d + +character(len=NF90_MAX_NAME) :: varname + +write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + +call nc_get_variable(ncid, varname, data0d,& + context="read_filter_io_block0d") + +end subroutine read_filter_io_block0d + + +!================================================================== + !================================================================== ! diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index de635f0378..62040c6278 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -164,7 +164,7 @@ &model_nml debug = 100 - filter_inout_dir = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' + filter_io_dir = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' estimate_f10_7 = .false. f10_7_file_name = 'f10_7.nc' variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', @@ -185,10 +185,16 @@ Vertical\ Wind &aether_to_dart_nml - aether_restart_input_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' + aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' aether_to_dart_output_file = 'filter_input.nc' / +&dart_to_aether_nml + aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' + filter_io_root = 'filter_output', + / +! 4 digit member number and .nc will be appended to this. + &cov_cutoff_nml select_localization = 1 / From 055c39c65557ef46d6c883074d9af22d324d0047 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sat, 25 Nov 2023 08:42:18 -0700 Subject: [PATCH 053/124] Converts Aether field names to CF-compliant It appears that Aether restart files will continue to be not CF-compliant. This commit adds functions to convert the Aether field names into: a) something that the nf90 routines can find in the restart files, b) something CF-compliant for writing to the filter_input.nc files. E.g. 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)' -> a) 'Perp. Ion Velocity (Vertical) (O+)' -> b) 'Opos_Perp_Ion_Velocity_Vertical' Moving the species from the end to the start will make output from some NetCDF processing tools more coherent by grouping all fields related to a species together, instead of all "Perp."... fields. The strategy is to fill aether_to_dart_nml and dart_to_aether_nml "variables" with Aether names, and model_nml "variables" with the corresponding CF-compliant names. It may be necessary for a user to run aether_to_dart independently of an assimilation to generate the CF names. _to_ programs no longer read model_mod_nml. aether_to_dart.f90 Moved the namelist read from here into model_mod:static_init_block aether_to_dart_nml, dart_to_aether_nml Added 'variables' model_mod.f90: aeth_name_to_dart Construct a CF-compliant field name from strings derived from the Aether field name. purge_chars Remove unwanted characters from the input string. Optionally replace '+' and '-' with 'pos' and 'neg' obstypelength, from types_mod, is too small for Aether names Removed global variables from some argument lists Initialize restart file fields (dart_to_aether) with NF90_FILL_REAL so that halos of variables which have non-meaningful data will appear that way. This code runs and creates a correct filter_input_0001.nc file. TODO: Implement these changes in dart_to_aether. Decide whether the QTYs assigned to ion velocities are optimal. Permute the dimensions from Aether's (lon,lat,z) (z varies first) with CF (z,lat,lon) (lon varies first). Debug why some character dimensions couldn't use NF90_MAX_NAME and needed 256 instead. Remove extraneous code; debugging prints and unused variables. --- models/aether_lon-lat/aether_to_dart.f90 | 71 +++--- models/aether_lon-lat/aether_to_dart.nml | 31 ++- models/aether_lon-lat/model_mod.f90 | 291 ++++++++++++++++++----- models/aether_lon-lat/model_mod.nml | 4 +- models/aether_lon-lat/work/input.nml | 38 +++ 5 files changed, 333 insertions(+), 102 deletions(-) diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index 6d5ae26de8..6ecb7dd7ca 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -44,18 +44,19 @@ program aether_to_dart character(len=512) :: string1, string2 character(len=*), parameter :: program_name = 'aether_to_dart' -!----------------------------------------------------------------------- -! namelist parameters with default values. -!----------------------------------------------------------------------- - -character(len=256) :: aether_restart_input_dirname = 'none' -! TODO: the calling script will need to move this to a name with $member in it, -! or use filter_nml:input_state_file_list -character(len=256) :: aether_to_dart_output_file = 'filter_input.nc' - -namelist /aether_to_dart_nml/ aether_restart_input_dirname, & - aether_to_dart_output_file - +! !----------------------------------------------------------------------- +! ! namelist parameters with default values. +! !----------------------------------------------------------------------- +! +! character(len=256) :: aether_restart_input_dirname = 'none' +! ! TODO: the calling script will need to move this to a name with $member in it, +! ! or use filter_nml:input_state_file_list +! ! TODO: Create the filter filename from filter_root, as in dart_to_aether. +! character(len=256) :: aether_to_dart_output_file = 'filter_input.nc' +! +! namelist /aether_to_dart_nml/ aether_restart_input_dirname, & +! aether_to_dart_output_file, variables +! !---------------------------------------------------------------------- ! global storage !---------------------------------------------------------------------- @@ -66,13 +67,16 @@ program aether_to_dart call initialize_utilities(program_name) -!---------------------------------------------------------------------- -! Read the namelist -!---------------------------------------------------------------------- - -call find_namelist_in_file("input.nml", "aether_to_dart_nml", iunit) -read(iunit, nml = aether_to_dart_nml, iostat = io) -call check_namelist_read(iunit, io, "aether_to_dart_nml") ! closes, too. +! !---------------------------------------------------------------------- +! ! Read the namelist +! !---------------------------------------------------------------------- +! +! call find_namelist_in_file("input.nml", "aether_to_dart_nml", iunit) +! read(iunit, nml = aether_to_dart_nml, iostat = io) +! call check_namelist_read(iunit, io, "aether_to_dart_nml") ! closes, too. +! +! ! error-check, convert namelist input to variable_table, and build the state structure +! call make_variable_table() !---------------------------------------------------------------------- ! Get the ensemble member @@ -86,21 +90,20 @@ program aether_to_dart ! Convert the files !---------------------------------------------------------------------- -call error_handler(E_MSG, '', '') -write(string1,*) 'converting aether restart files in directory ', & - "'"//trim(aether_restart_input_dirname)//"'" -write(string2,*) ' to the NetCDF file ', "'"//trim(aether_to_dart_output_file)//"'" -call error_handler(E_MSG, program_name, string1, text2=string2) -call error_handler(E_MSG, '', '') - -call restart_files_to_netcdf(aether_restart_input_dirname, member, & - aether_to_dart_output_file) - -call error_handler(E_MSG, '', '') -write(string1,*) 'Successfully converted the GITM restart files to ', & - "'"//trim(aether_to_dart_output_file)//"'" -call error_handler(E_MSG, program_name, string1) -call error_handler(E_MSG, '', '') +! call error_handler(E_MSG, '', '') +! write(string1,*) 'converting aether restart files in directory ', & +! "'"//trim(aether_restart_input_dirname)//"'" +! write(string2,*) ' to the NetCDF file ', "'"//trim(aether_to_dart_output_file)//"'" +! call error_handler(E_MSG, program_name, string1, text2=string2) +! call error_handler(E_MSG, '', '') + +call restart_files_to_netcdf(member) + +! call error_handler(E_MSG, '', '') +! write(string1,*) 'Successfully converted the GITM restart files to ', & +! "'"//trim(aether_to_dart_output_file)//"'" +! call error_handler(E_MSG, program_name, string1) +! call error_handler(E_MSG, '', '') !---------------------------------------------------------------------- ! Finish up diff --git a/models/aether_lon-lat/aether_to_dart.nml b/models/aether_lon-lat/aether_to_dart.nml index cc9c542b53..88d62bb5cd 100644 --- a/models/aether_lon-lat/aether_to_dart.nml +++ b/models/aether_lon-lat/aether_to_dart.nml @@ -1,5 +1,32 @@ &aether_to_dart_nml - aether_restart_input_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' + aether_restart_dirname = + '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1' aether_to_dart_output_file = 'filter_input.nc' + variables = + 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', + 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', + 'O+', + 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + 'Temperature\ \(O+\)', + 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' / - + +! TODO: Or could use these. What's the difference? +! Would it be useful to use 1 type for Parallel and the other for Perp.? + QTY_VELOCITY_U + QTY_VELOCITY_V + QTY_VELOCITY_W + QTY_VERTICAL_VELOCITY + ... diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 2748442067..2ff1e6db71 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -1,7 +1,6 @@ ! 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 module was copied from models/tiegcm ! but has restart reading and writing routines from ../gitm, @@ -14,6 +13,12 @@ ! The model_mod.nml initially has the namelists from both tiegcm and gitm. ! Parts of both may be useful and will be merged into a new aether_lon-lat nml. +! The module is organized into sections: +! Routines in this section (down to "private") are public. +! Routines below here are private to the module +! Routines for initialization. +! Routines for aether_to_dart. +! Routines for dart_to_aether. module model_mod @@ -155,7 +160,7 @@ module model_mod character(len=256) :: filter_io_dir = '.' ! TODO; remove GITM namelist vars ! TODO: if filter_io_filename is in global storage it doesn't need to be in (some?) arg lists. -character(len=256) :: filter_io_filename = 'no_file_specified.nc' +character(len=256) :: filter_io_filename = 'filter_input_0001.nc' integer :: debug = 0 logical :: estimate_f10_7 = .false. character(len=256) :: f10_7_file_name = 'f10_7.nc' @@ -187,6 +192,19 @@ module model_mod f10_7_file_name, calendar, assimilation_period_seconds, & model_res +!----------------------------------------------------------------------- +! aether_to_dart namelist parameters with default values. +!----------------------------------------------------------------------- + +character(len=256) :: aether_restart_dirname = 'none' +! TODO: the calling script will need to move this to a name with $member in it, +! or use filter_nml:input_state_file_list +! TODO: Create the filter filename from filter_root, as in dart_to_aether. +character(len=256) :: aether_to_dart_output_file = 'filter_input.nc' + +namelist /aether_to_dart_nml/ aether_restart_dirname, & + aether_to_dart_output_file, variables + !------------------------------------------------------------------------------- ! define model parameters for creating the state NetCDF file ! and handling interpolation, get_close, ... @@ -213,7 +231,7 @@ module model_mod integer, parameter :: VT_ORIGININDX = 5 ! file of origin integer, parameter :: VT_STATEINDX = 6 ! update (state) or not -character(len=obstypelength) :: variable_table(MAX_NUM_VARIABLES, MAX_NUM_COLUMNS) +character(len=64) :: variable_table(MAX_NUM_VARIABLES, MAX_NUM_COLUMNS) type(time_type) :: state_time ! module-storage declaration of current model time @@ -308,7 +326,7 @@ subroutine static_init_model() !--------------------------------------------------------------- ! get grid dimensions and values -call get_grid_from_netcdf(filter_io_filename, lons, lats, alts) +call get_grid_from_netcdf(lons, lats, alts) !--------------------------------------------------------------- @@ -411,11 +429,9 @@ end function block_file_name !> is orthogonal and rectangular but can have irregular spacing along !> any or all of the three dimensions. -subroutine restart_files_to_netcdf(restart_dirname, member, filter_io_file) +subroutine restart_files_to_netcdf(member) ! TODO: Does restart_files_to_netcdf need restart_dir? -character(len=*), intent(in) :: restart_dirname -character(len=*), intent(in) :: filter_io_file integer, intent(in) :: member integer :: ncid @@ -428,9 +444,17 @@ subroutine restart_files_to_netcdf(restart_dirname, member, filter_io_file) call error_handler(E_ERR,routine,string1,source,revision,revdate) end if -call static_init_blocks(restart_dirname) +call static_init_blocks() -ncid = nc_create_file(filter_io_file) +call error_handler(E_MSG, '', '') +write(string1,*) 'converting Aether restart files in directory ', & + "'"//trim(aether_restart_dirname)//"'" +write(string2,*) ' to the NetCDF file ', "'"//trim(aether_to_dart_output_file)//"'" +call error_handler(E_MSG, routine, string1, text2=string2) +call error_handler(E_MSG, '', '') + +write(filter_io_filename,'(A,I0.4,A3)') 'filter_input_',member+1,'.nc' +ncid = nc_create_file(filter_io_filename) ! DONE: This should probably be replaced by nc_write_model_atts(ncid). ! That may require renaming some dimension variables. @@ -438,20 +462,27 @@ subroutine restart_files_to_netcdf(restart_dirname, member, filter_io_file) ! Enters and exits define mode; call nc_write_model_atts(ncid, 0) -call restarts_to_filter(restart_dirname, ncid, member, define=.true.) +call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) ! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts ! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying ! the state vector field names and source. ! call add_nc_dimvars(ncid) -call restarts_to_filter(restart_dirname, ncid, member, define=.false.) +call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) ! TODO: this needs to be updated to write to which file? ! call write_model_time(ncid, state_time) call nc_close_file(ncid) +call error_handler(E_MSG, '', '') +write(string1,*) 'Successfully converted the Aether restart files to ', & + "'"//trim(aether_to_dart_output_file)//"'" +call error_handler(E_MSG, routine, string1) +call error_handler(E_MSG, '', '') + + end subroutine restart_files_to_netcdf !================================================================= @@ -479,7 +510,7 @@ subroutine netcdf_to_restart_files(nc_file, member, output_dirname) call error_handler(E_ERR,routine,string1,source,revision,revdate) end if -call static_init_blocks(output_dirname) +call static_init_blocks() ncid = nc_open_file_readonly(nc_file, routine) @@ -1208,9 +1239,8 @@ end subroutine make_variable_table ! Read the lon, lat, and alt arrays from the ncid -subroutine get_grid_from_netcdf(filter_io_filename, lons, lats, alts ) +subroutine get_grid_from_netcdf(lons, lats, alts ) -character(len=*), intent(in) :: filter_io_filename real(r8), intent(inout) :: lons(:) real(r8), intent(inout) :: lats(:) real(r8), intent(inout) :: alts(:) @@ -1231,9 +1261,8 @@ end subroutine get_grid_from_netcdf !================================================================= -subroutine static_init_blocks(restart_dirname) +subroutine static_init_blocks() -character(len=*), intent(in) :: restart_dirname character(len=128) :: aether_filename character(len=*), parameter :: routine = 'static_init_blocks' @@ -1247,26 +1276,24 @@ subroutine static_init_blocks(restart_dirname) ! This prevents subroutines called from here from calling static_init_mod. module_initialized = .true. -! Read the namelist entry for model_mod from input.nml -call read_model_namelist() +!---------------------------------------------------------------------- +! Read the aether_to_dart namelist +!---------------------------------------------------------------------- +! NEWIC; a2d will now read 'variables' from its own namelist. +! I think/hope that a2d doesn't need any other variables from model_nml. -! error-check, convert namelist input to variable_table, and build the state structure -call make_variable_table() +! TODO: filter_io_dir from here instead of redundant entry in model_mod_nml? +call find_namelist_in_file("input.nml", "aether_to_dart_nml", iunit) +read(iunit, nml = aether_to_dart_nml, iostat = io) +call check_namelist_read(iunit, io, "aether_to_dart_nml") ! closes, too. ! 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) +if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) +if (do_nml_term()) write( * , nml=aether_to_dart_nml) -! TODO: Reading aether_to_dart_nml is done only in aether_to_dart? -! filter_io_dir from here instead of redundant entry in model_mod_nml? -! ! Read the DART namelist for this model -! call find_namelist_in_file('input.nml', 'aether_to_dart_nml', iunit) -! read(iunit, nml = aether_to_dart_nml, iostat = io) -! call check_namelist_read(iunit, io, 'aether_to_dart_nml') -! -! ! Record the namelist values used for the run -! if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) -! if (do_nml_term()) write( * , nml=aether_to_dart_nml) +! error-check, convert namelist input to variable_table, and build the state structure +! 'variables' comes from aether_to_dart_nml +call make_variable_table() !--------------------------------------------------------------- ! Set the time step ... causes gitm namelists to be read. @@ -1281,7 +1308,7 @@ subroutine static_init_blocks(restart_dirname) ! 2) allocate space for the grids ! 3) read them from the block restart files, could be stretched ... -call get_grid_info_from_blocks(restart_dirname, nlon, nlat, nalt, nBlocksLon, & +call get_grid_info_from_blocks(aether_restart_dirname, nlon, nlat, nalt, nBlocksLon, & nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) print*,'static_init_blocks: post-get_grid_info_from_blocks; nfields_neutral = ', nfields_neutral @@ -1291,7 +1318,7 @@ subroutine static_init_blocks(restart_dirname) endif ! Opens and closes the grid block file, but not the filter netcdf file. -call get_grid_from_blocks(restart_dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & +call get_grid_from_blocks(aether_restart_dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & nxPerBlock, nyPerBlock, nzPerBlock, lons, lats, alts ) ! Convert the Aether reference date (not calendar day = 0 date) @@ -1302,7 +1329,7 @@ subroutine static_init_blocks(restart_dirname) ! Get the model time from a restart file. aether_filename = block_file_name(variable_table(1,VT_ORIGININDX), 0, 0) -state_time = read_model_time(trim(restart_dirname)//'/'//trim(aether_filename)) +state_time = read_model_time(trim(aether_restart_dirname)//'/'//trim(aether_filename)) ! TODO: Replace with aether variables check? (OR is that done when trying to read them?) ! call verify_block_variables( gitm_block_variables, nfields ) @@ -1509,6 +1536,121 @@ end function read_in_real ! Routines for aether_to_dart. !================================================================== +!----------------------------------------------------------------------------- +! Translate an Aether field name (not CF-compliant) into a form filter likes. +! E.g. 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', -> +! 'Opos_Perp_Ion_Velocity_Meridional' + +function aeth_name_to_dart(varname) + +! TODO: NF90_MAX_NAME was not usable in the test program. Usable in model_mod? +! character(len=NF90_MAX_NAME), intent(in) :: varname +character(len=256), intent(in) :: varname + +! character(len=NF90_MAX_NAME) :: aeth +character(len=256) :: aeth +character(len=128) :: aeth_name_to_dart +character(len=64) :: parts(8), var_root +integer :: char_num, first, i_parts, aeth_len, end_str + +aeth = trim(varname) +aeth_len = len_trim(varname) +parts = '' + +! Look for the last ' '. The characters after that are the species. +! If there's no ' ', the whole string is the species. +char_num = 0 +char_num = scan(trim(aeth),' ',back=.true.) +var_root = aeth(char_num+1:aeth_len) +! purge_chars removes unwanted [()\] +parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) +print*,'var_root, parts(1) = ',var_root, parts(1) +end_str = char_num + +! Tranform remaining pieces of varname into DART versions. +char_num = MISSING_I +first = 1 +i_parts = 2 +do + ! This returns the position of the first blank *within the substring* passed in. + char_num = scan(aeth(first:end_str),' ',back=.false.) + if (char_num > 0 .and. first < aeth_len) then + parts(i_parts) = purge_chars(aeth(first:first+char_num-1), '.)(\', plus_minus=.true.) + + first = first + char_num + i_parts = i_parts + 1 + else + exit + endif +enddo + +! Construct the DART field name from the parts +aeth_name_to_dart = trim(parts(1)) +i_parts = 2 +do +if (trim(parts(i_parts)) /= '') then + aeth_name_to_dart = trim(aeth_name_to_dart)//'_'//trim(parts(i_parts)) + i_parts = i_parts + 1 +else + exit +endif +enddo + +end function aeth_name_to_dart + +!----------------------------------------------------------------- +! Replace undesirable characters with better. + +function purge_chars(ugly_string, chars, plus_minus) + +character (len=*), intent(in) :: ugly_string, chars +logical, intent(in) :: plus_minus +character (len=64) :: purge_chars +character (len=256) :: temp_str + +integer :: char_num, end_str, pm_num + +! Trim is not needed here +temp_str = ugly_string +end_str = len_trim(temp_str) +print*,'len_trim(str), ugly_string = ',end_str, ugly_string,'||end' +print*,'temp_str = ',temp_str,'||end' +char_num = MISSING_I +do + ! Returns 0 if chars are not found + char_num = scan(temp_str,chars) + print*,'char_num, temp_str = ',char_num, trim(temp_str) + ! Need to change it to a char that won't be found by scan in the next iteration, + ! and can be easily removed. + if (char_num > 0) then + ! Squeeze out the character + temp_str(char_num:end_str-1) = temp_str(char_num+1:end_str) + temp_str(end_str:end_str) = '' +! temp_str(char_num:char_num) = ' ' + else + exit + endif +enddo + +! Replace + and - with pos and neg. Assume there's only 1. +temp_str = trim(adjustl(temp_str)) +end_str = len_trim(temp_str) +pm_num = scan(trim(temp_str),'+-',back=.false.) +if (pm_num == 0 .or. .not. plus_minus) then + purge_chars = trim(temp_str) +else + if (temp_str(pm_num:pm_num) == '+') then + purge_chars = temp_str(1:pm_num-1)//'pos' + else if (temp_str(pm_num:pm_num) == '-') then + purge_chars = temp_str(1:pm_num-1)//'neg' + endif + if (pm_num+1 <= end_str) & + purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) +endif + +end function purge_chars + +!----------------------------------------------------------------- ! open enough of the restart files to read in the lon, lat, alt arrays subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & @@ -1915,7 +2057,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) character(len=*), parameter :: routine = 'block_to_filter_io' character(len=128) :: file_root character(len=256) :: filename -character(len=NF90_MAX_NAME) :: varname +character(len=NF90_MAX_NAME) :: varname, dart_varname block(1) = ib block(2) = jb @@ -2048,7 +2190,13 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) print*,'block_to_filter_io: nfields_neutral = ',nfields_neutral do ivar = 1, nfields_neutral - write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) +! TODO: the nf90 functions cannot read the variable names with the '\'s in them. +! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) + print*,routine,'varname = ',varname +! NEWIC; +! Translate the Aether field name into a DART field name. + dart_varname = aeth_name_to_dart(varname) ! TODO: Given the subroutine name, perhaps these definition sections should be ! one call higher up, with the same loop around it. @@ -2057,31 +2205,31 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! The calling routine entered define mode. if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',varname + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',dart_varname call error_handler(E_MSG,routine,string1,source,revision,revdate) end if - call nc_define_real_variable(ncid_output, varname, & + call nc_define_real_variable(ncid_output, dart_varname, & (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) - print*,routine,': defined ivar, varname = ', ivar, varname + print*,routine,': defined ivar, dart_varname = ', ivar, dart_varname ! TODO: does the filter_input.nc file need all these attributes? TIEGCM doesn't add them. ! They are not available from the restart files. ! Add them to the ions section too. - ! call nc_add_attribute_to_variable(ncid, varname, 'long_name', gitmvar(ivar)%long_name) - ! call nc_add_attribute_to_variable(ncid, varname, 'units', gitmvar(ivar)%units) - ! !call nc_add_attribute_to_variable(ncid, varname, 'storder', gitmvar(ivar)%storder) - ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) - ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) - ! call nc_add_attribute_to_variable(ncid, varname, 'gitm_index', gitmvar(ivar)%gitm_index) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'long_name', gitmvar(ivar)%long_name) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'units', gitmvar(ivar)%units) + ! !call nc_add_attribute_to_variable(ncid, dart_varname, 'storder', gitmvar(ivar)%storder) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_index', gitmvar(ivar)%gitm_index) else if (file_root == 'neutrals') then ! Read 3D array and extract the non-halo data of this block. ! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. call nc_get_variable(ncid_input, varname, temp3d, context=routine) - print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),variable_table(ivar,VT_VARNAMEINDX) + print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),varname print*,'block_to_filter_io: define = ',define - call write_filter_io(temp3d, ivar, block, ncid_output) + call write_filter_io(temp3d, dart_varname, block, ncid_output) else write(string1,*) 'Trying to read neutrals, but variable_table(',ivar,VT_ORIGININDX, & ') /= "neutrals"' @@ -2097,22 +2245,28 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) print*,'block_to_filter_io: nfields_ion = ',nfields_ion do ivar = nfields_neutral +1,nfields_neutral + nfields_ion - write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) +! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) + print*,'Purging \ from aether name' + varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) +! NEWIC; +! Translate the Aether field name into a DART field name. + print*,'Converting aether name ',trim(varname) + dart_varname = aeth_name_to_dart(varname) if (define) then if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',varname + write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',dart_varname call error_handler(E_MSG,routine,string1,source,revision,revdate) end if - call nc_define_real_variable(ncid_output, varname, & + call nc_define_real_variable(ncid_output, dart_varname, & (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) - print*,routine,': defined ivar, varname = ', ivar, varname + print*,routine,': defined ivar, dart_varname = ', ivar, dart_varname else if (file_root == 'ions') then call nc_get_variable(ncid_input, varname, temp3d, context=routine) - call write_filter_io(temp3d, ivar, block, ncid_output) + call write_filter_io(temp3d, dart_varname, block, ncid_output) else write(string1,*) 'Trying to read ions, but variable_table(',ivar,VT_ORIGININDX, & ') /= "ions"' @@ -2261,24 +2415,23 @@ end subroutine block_to_filter_io ! put the requested data into a netcdf variable -subroutine write_filter_io(data3d, ivar, block, ncid) +subroutine write_filter_io(data3d, varname, block, ncid) real(r4), intent(in) :: data3d(1:nzPerBlock, & 1-nGhost:nyPerBlock+nGhost, & 1-nGhost:nxPerBlock+nGhost) -integer, intent(in) :: ivar ! variable index +character(len=NF90_MAX_NAME), intent(in) :: varname integer, intent(in) :: block(2) integer, intent(in) :: ncid integer :: ib, jb integer :: starts(3) character(len=*), parameter :: routine = 'write_filter_io' -character(len=NF90_MAX_NAME) :: varname print*,routine,': data3d = ',data3d(1,1,1),data3d(15,15,15) -write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) +! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) ib = block(1) jb = block(2) @@ -2323,17 +2476,24 @@ subroutine filter_to_restarts(dirnameout, ncid, member) ! get the dirname, construct the filenames inside open_block_file - +! >>> TODO: Not all fields have halos suitable for calculating gradients. +! These do (2023-11-8): neutral temperature, O, O2, N2, and the horizontal winds. +! The current model_mod will fill all neutral halos anyway, +! since that's simpler and won't break the model. +! TODO: add an attribute to the variable_table (?) to denote whether a field +! should have its halo filled. do ivar = 1, nfields_neutral varname = trim(variable_table(ivar,VT_VARNAMEINDX)) print*,routine,': How long is varname after assignment with trim? ',varname,' end' file_root = trim(variable_table(ivar,VT_ORIGININDX)) if (file_root == 'neutrals') then - fulldom3d = MISSING_R4 + ! fulldom3d = MISSING_R4 + ! Assuming that this parameter is available through the `use netcdf` command. + fulldom3d = NF90_FILL_REAL call nc_get_variable(ncid, varname, fulldom3d(1:nalt,1:nlat,1:nlon), & nc_count=(/nalt,nlat,nlon/),context=routine) - !? ncount not needed? Reading the whole field. + ! TODO: ncount not needed? Reading the whole field. ! Copy updated field values to full domain halo. ! Block domains+halos will be easily read from this. @@ -2349,16 +2509,20 @@ subroutine filter_to_restarts(dirnameout, ncid, member) do ivar = nfields_neutral+1, nfields_neutral + nfields_ion varname = trim(variable_table(ivar,VT_VARNAMEINDX)) file_root = trim(variable_table(ivar,VT_ORIGININDX)) - print*,routine,': varname, fileroot = ',varname, fileroot + print*,routine,': varname, file_root = ',varname, file_root if (file_root == 'ions') then + fulldom3d = NF90_FILL_REAL call nc_get_variable(ncid, varname, fulldom3d(1:nalt,1:nlat,1:nlon), & nc_count=(/nalt,nlat,nlon/),context=routine) !? ncount not needed? Reading the whole field. ! Copy updated field values to full domain halo. ! Block domains+halos will be easily read from this. - call add_halo_fulldom3d(fulldom3d) + ! 2023-11: ions do not have real or used data in their halos. + ! Make this clear by leaving the halos filled with MISSING_R4 + ! TODO: Will this be translated into NetCDF missing_value? + ! call add_halo_fulldom3d(fulldom3d) call filter_io_to_blocks(fulldom3d, varname, file_root, member) @@ -2394,9 +2558,6 @@ subroutine add_halo_fulldom3d(fulldom3d) haflat = nlat/2 haflon = nlon/2 -TODO: this is incorrect. Some sort of interpolation is done, instead of copying values. - Email from Aaron should point the way. - do g = 1,nGhost ! left; reach around the date line. ! There's no data at the ends of the halos for this copy. diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index 87f22bc734..f2f2070730 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -1,4 +1,3 @@ -! TIEGCM: (Any variables from GITM?) &model_nml debug = 100 filter_io_dir = 'testdata1/restartOut.Sphere.1member' @@ -10,6 +9,9 @@ assimilation_period_seconds = 3600 / ! >>> Don't code these until we get new CF-compliant field names from Aaron. <<< +! >>> Not all fields have halos suitable for calculating gradients. These do (2023-11-8): +! neutral temperature, O, O2, N2, and the horizontal winds. +! The current model_mod will fill all halos anyway, since that's simpler and won't break the model. ! Other neutrals from restart files, which Aaron identified as important: Zonal\ Wind Meridional\ Wind diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index 62040c6278..0f5fc3dcc3 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -187,11 +187,49 @@ &aether_to_dart_nml aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' aether_to_dart_output_file = 'filter_input.nc' + variables = + 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', + 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', + 'O+', + 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + 'Temperature\ \(O+\)', + 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' / &dart_to_aether_nml aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' filter_io_root = 'filter_output', + variables = + 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', + 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', + 'O+', + 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + 'Temperature\ \(O+\)', + 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' / ! 4 digit member number and .nc will be appended to this. From 03d33d3ddd87476f2156698a1f6fe29d8307b1e8 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 28 Nov 2023 13:52:50 -0700 Subject: [PATCH 054/124] Adapted dart_to_aether to CF-compliant variables. Similar to the previous commit of aether_to_dart. Some minor changes to dart_to_aether to be consistent. dart_to_aether Moved namelist read into model_mod:static_init_blocks. Removed arguments from netcdf_to_restart_files, which carried file info from the namelist. dart_to_aether_nml aether_to_dart_nml Now have consistent contents, including filter_io_root which is used to create the DART file name. model_mod Handles *_to_* namelists consistently. static_init_blocks; takes a namelist name to read either dart_to_aether_nml or aether_to_dart_nml. Both *_to_* programs passed the visual tests. The Aether restart files, after the conversion back and forth, have the expected "missing values" in the halos, instead of pretend data. TODO; Transpose dimensions in the filter_io files to be CF-compliant. >>> This will probably be done in Aether, so model_mod will need to be updated. Clean out junk. Merge with Ben's pieces of model_mod. --- models/aether_lon-lat/aether_to_dart.nml | 4 +- models/aether_lon-lat/dart_to_aether.f90 | 39 +-------- models/aether_lon-lat/dart_to_aether.nml | 22 ++++- models/aether_lon-lat/model_mod.f90 | 102 +++++++++++++++-------- models/aether_lon-lat/work/input.nml | 2 +- 5 files changed, 92 insertions(+), 77 deletions(-) diff --git a/models/aether_lon-lat/aether_to_dart.nml b/models/aether_lon-lat/aether_to_dart.nml index 88d62bb5cd..1e982e1b1a 100644 --- a/models/aether_lon-lat/aether_to_dart.nml +++ b/models/aether_lon-lat/aether_to_dart.nml @@ -1,7 +1,7 @@ &aether_to_dart_nml aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1' - aether_to_dart_output_file = 'filter_input.nc' + '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata2' + filter_io_root = 'filter_input' variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90 index 213015fd53..dcea5b5715 100644 --- a/models/aether_lon-lat/dart_to_aether.f90 +++ b/models/aether_lon-lat/dart_to_aether.f90 @@ -34,18 +34,6 @@ program dart_to_aether character(len=*), parameter :: progname = 'dart_to_aether' -!----------------------------------------------------------------------- -! namelist parameters with default values. -!----------------------------------------------------------------------- - -character (len = 256) :: aether_restart_dirname = 'none' -character (len = 64) :: filter_io_root = 'filter_output' -character (len = 64) :: filter_io_name - -namelist /dart_to_aether_nml/ & - aether_restart_dirname, & - filter_io_root - !---------------------------------------------------------------------- ! global storage !---------------------------------------------------------------------- @@ -62,41 +50,16 @@ program dart_to_aether read '(I3)', member print*,'dart_to_aether: member = ',member -write(filter_io_name,'(2A,I0.4,A3)') trim(filter_io_root),'_',member,'.nc' - !====================================================================== call initialize_utilities(progname=progname) -!---------------------------------------------------------------------- -! Read the namelist -!---------------------------------------------------------------------- - -call find_namelist_in_file("input.nml", "dart_to_aether_nml", iunit) -read(iunit, nml = dart_to_aether_nml, iostat = io) -call check_namelist_read(iunit, io, "dart_to_aether_nml") ! closes, too. - -print*,'After namelist; aether_restart_dirname = ',aether_restart_dirname - -call error_handler(E_MSG,progname,'','',revision,revdate) -write(string1,*) 'Extracting fields from DART file ', "'"//trim(filter_io_name)//"'" -write(string2,*) 'into Aether restart files in directory ', "'"//trim(aether_restart_dirname)//"'" -call error_handler(E_MSG,progname,string1,source,revision,revdate,text2=string2) - !---------------------------------------------------------------------- ! Reads the valid time, the state, and the target time. !---------------------------------------------------------------------- ! TODO: netcdf_to_restart_files; need all these file and dir names? -call netcdf_to_restart_files(filter_io_name, member, aether_restart_dirname) - -!---------------------------------------------------------------------- -! Log what we think we're doing, and exit. -!---------------------------------------------------------------------- -call error_handler(E_MSG,progname,'','',revision,revdate) -write(string1,*) 'Successfully converted to the Aether restart files in directory' -write(string2,*) "'"//trim(aether_restart_dirname)//"'" -call error_handler(E_MSG,progname,string1,source,revision,revdate,text2=string2) +call netcdf_to_restart_files(member) ! end - close the log, etc call finalize_utilities() diff --git a/models/aether_lon-lat/dart_to_aether.nml b/models/aether_lon-lat/dart_to_aether.nml index dd90fcaf3f..0b2562025c 100644 --- a/models/aether_lon-lat/dart_to_aether.nml +++ b/models/aether_lon-lat/dart_to_aether.nml @@ -1,6 +1,26 @@ &dart_to_aether_nml - aether_restart_dirname = /Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member + aether_restart_dirname = + '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata2' filter_io_root = 'filter_output', + variables = + 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', + 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', + 'O+', + 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + 'Temperature\ \(O+\)', + 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Parallel\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', + 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' / ! 4 digit member number and .nc will be appended to this. diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 2ff1e6db71..53b10b2169 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -199,11 +199,14 @@ module model_mod character(len=256) :: aether_restart_dirname = 'none' ! TODO: the calling script will need to move this to a name with $member in it, ! or use filter_nml:input_state_file_list -! TODO: Create the filter filename from filter_root, as in dart_to_aether. -character(len=256) :: aether_to_dart_output_file = 'filter_input.nc' +character (len = 64) :: filter_io_root = 'filter_input' -namelist /aether_to_dart_nml/ aether_restart_dirname, & - aether_to_dart_output_file, variables +namelist /aether_to_dart_nml/ aether_restart_dirname, filter_io_root, variables + +! dart_to_aether namelist parameters with default values. +!----------------------------------------------------------------------- + +namelist /dart_to_aether_nml/ aether_restart_dirname, filter_io_root, variables !------------------------------------------------------------------------------- ! define model parameters for creating the state NetCDF file @@ -320,6 +323,7 @@ subroutine static_init_model() " for grid information" call error_handler(E_MSG,routine,string1,source,revision,revdate) +! TODO; do these need to be deallocated somewhere? allocate(lons(nlon)) allocate(lats(nlat)) allocate(alts(nalt)) @@ -444,18 +448,18 @@ subroutine restart_files_to_netcdf(member) call error_handler(E_ERR,routine,string1,source,revision,revdate) end if -call static_init_blocks() +call static_init_blocks("aether_to_dart_nml") + +write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member+1,'.nc' +ncid = nc_create_file(filter_io_filename) call error_handler(E_MSG, '', '') write(string1,*) 'converting Aether restart files in directory ', & "'"//trim(aether_restart_dirname)//"'" -write(string2,*) ' to the NetCDF file ', "'"//trim(aether_to_dart_output_file)//"'" +write(string2,*) ' to the NetCDF file ', "'"//trim(filter_io_filename)//"'" call error_handler(E_MSG, routine, string1, text2=string2) call error_handler(E_MSG, '', '') -write(filter_io_filename,'(A,I0.4,A3)') 'filter_input_',member+1,'.nc' -ncid = nc_create_file(filter_io_filename) - ! DONE: This should probably be replaced by nc_write_model_atts(ncid). ! That may require renaming some dimension variables. ! call add_nc_definitions(ncid) @@ -478,7 +482,7 @@ subroutine restart_files_to_netcdf(member) call error_handler(E_MSG, '', '') write(string1,*) 'Successfully converted the Aether restart files to ', & - "'"//trim(aether_to_dart_output_file)//"'" + "'"//trim(filter_io_filename)//"'" call error_handler(E_MSG, routine, string1) call error_handler(E_MSG, '', '') @@ -489,14 +493,11 @@ end subroutine restart_files_to_netcdf ! Writes the current time and state variables from a dart state ! vector (1d array) into a gitm netcdf restart file. -subroutine netcdf_to_restart_files(nc_file, member, output_dirname) +subroutine netcdf_to_restart_files(member) -character(len=*), intent(in) :: nc_file -character(len=*), intent(in) :: output_dirname integer, intent(in) :: member integer :: ncid - character(len=*), parameter :: routine = 'netcdf_to_restart_files:' ! sort the required fields into the order they exist in the @@ -510,11 +511,26 @@ subroutine netcdf_to_restart_files(nc_file, member, output_dirname) call error_handler(E_ERR,routine,string1,source,revision,revdate) end if -call static_init_blocks() +call static_init_blocks("dart_to_aether_nml") -ncid = nc_open_file_readonly(nc_file, routine) +write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member+1,'.nc' -call filter_to_restarts(output_dirname, ncid, member) +call error_handler(E_MSG,routine,'','',revision,revdate) +write(string1,*) 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" +write(string2,*) 'into Aether restart files in directory ', "'"//trim(aether_restart_dirname)//"'" +call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2) + +ncid = nc_open_file_readonly(filter_io_filename, routine) + +call filter_to_restarts(ncid, member) + +!---------------------------------------------------------------------- +! Log what we think we're doing, and exit. +!---------------------------------------------------------------------- +call error_handler(E_MSG,routine,'','',revision,revdate) +write(string1,*) 'Successfully converted to the Aether restart files in directory' +write(string2,*) "'"//trim(aether_restart_dirname)//"'" +call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2) call nc_close_file(ncid) @@ -1261,7 +1277,9 @@ end subroutine get_grid_from_netcdf !================================================================= -subroutine static_init_blocks() +subroutine static_init_blocks(nml) + +character(len=*), intent(in) :: nml character(len=128) :: aether_filename @@ -1283,13 +1301,20 @@ subroutine static_init_blocks() ! I think/hope that a2d doesn't need any other variables from model_nml. ! TODO: filter_io_dir from here instead of redundant entry in model_mod_nml? -call find_namelist_in_file("input.nml", "aether_to_dart_nml", iunit) -read(iunit, nml = aether_to_dart_nml, iostat = io) -call check_namelist_read(iunit, io, "aether_to_dart_nml") ! closes, too. +call find_namelist_in_file("input.nml", trim(nml), iunit) +if (trim(nml) == 'aether_to_dart_nml') then + read(iunit, nml = aether_to_dart_nml, iostat = io) + ! Record the namelist values used for the run + if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) + if (do_nml_term()) write( * , nml=aether_to_dart_nml) +else if (trim(nml) == 'dart_to_aether_nml') then + read(iunit, nml = dart_to_aether_nml, iostat = io) + ! Record the namelist values used for the run + if (do_nml_file()) write(nmlfileunit, nml=dart_to_aether_nml) + if (do_nml_term()) write( * , nml=dart_to_aether_nml) +endif +call check_namelist_read(iunit, io, trim(nml)) ! closes, too. -! Record the namelist values used for the run -if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) -if (do_nml_term()) write( * , nml=aether_to_dart_nml) ! error-check, convert namelist input to variable_table, and build the state structure ! 'variables' comes from aether_to_dart_nml @@ -1699,6 +1724,7 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & ! This is also done in gitm's static_init_model, which is not called by aether_to_dart, ! so it's not redundant. +! TODO; do these need to be deallocated somewhere? allocate( lons( nlon )) allocate( lats( nlat )) allocate( alts( nalt )) @@ -2455,17 +2481,15 @@ end subroutine write_filter_io ! open all restart files and write out the requested data item -subroutine filter_to_restarts(dirnameout, ncid, member) -! TODO: Does filter_to_restarts need dirname and dirnameout? +subroutine filter_to_restarts(ncid, member) -character(len=*), intent(in) :: dirnameout integer, intent(in) :: member, ncid real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) character(len=256) :: file_root integer :: ivar -character(len=NF90_MAX_NAME):: varname +character(len=NF90_MAX_NAME):: varname, dart_varname character(len=*), parameter :: routine = 'filter_to_restarts' ! Space for full domain field (read from filter_output.nc) @@ -2483,15 +2507,18 @@ subroutine filter_to_restarts(dirnameout, ncid, member) ! TODO: add an attribute to the variable_table (?) to denote whether a field ! should have its halo filled. do ivar = 1, nfields_neutral - varname = trim(variable_table(ivar,VT_VARNAMEINDX)) - print*,routine,': How long is varname after assignment with trim? ',varname,' end' - file_root = trim(variable_table(ivar,VT_ORIGININDX)) + varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) + print*,routine,'varname = ',varname +! NEWIC; +! Translate the Aether field name into a DART field name. + dart_varname = aeth_name_to_dart(varname) + file_root = trim(variable_table(ivar,VT_ORIGININDX)) if (file_root == 'neutrals') then ! fulldom3d = MISSING_R4 ! Assuming that this parameter is available through the `use netcdf` command. fulldom3d = NF90_FILL_REAL - call nc_get_variable(ncid, varname, fulldom3d(1:nalt,1:nlat,1:nlon), & + call nc_get_variable(ncid, dart_varname, fulldom3d(1:nalt,1:nlat,1:nlon), & nc_count=(/nalt,nlat,nlon/),context=routine) ! TODO: ncount not needed? Reading the whole field. @@ -2507,13 +2534,18 @@ subroutine filter_to_restarts(dirnameout, ncid, member) enddo do ivar = nfields_neutral+1, nfields_neutral + nfields_ion - varname = trim(variable_table(ivar,VT_VARNAMEINDX)) + varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) +! NEWIC; +! Translate the Aether field name into a DART field name. + dart_varname = aeth_name_to_dart(varname) + file_root = trim(variable_table(ivar,VT_ORIGININDX)) - print*,routine,': varname, file_root = ',varname, file_root + print*,routine,': varname, dart_varname, file_root = ', & + trim(varname), trim(dart_varname), file_root if (file_root == 'ions') then fulldom3d = NF90_FILL_REAL - call nc_get_variable(ncid, varname, fulldom3d(1:nalt,1:nlat,1:nlon), & + call nc_get_variable(ncid, dart_varname, fulldom3d(1:nalt,1:nlat,1:nlon), & nc_count=(/nalt,nlat,nlon/),context=routine) !? ncount not needed? Reading the whole field. diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index 0f5fc3dcc3..a9aaa62c4e 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -186,7 +186,7 @@ &aether_to_dart_nml aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' - aether_to_dart_output_file = 'filter_input.nc' + filter_io_root = 'filter_input' variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', From 5721b3eb621564557de3f4e0333984511da72266 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 1 Dec 2023 08:56:20 -0700 Subject: [PATCH 055/124] Pruned unused code, improved debug messages. Worked through list from compiler. Kept stuff used in subroutines Ben is developing or that may be needed for TEC, f10.7. Converted many print* to error handler. --- models/aether_lon-lat/aether_to_dart.f90 | 14 +- models/aether_lon-lat/model_mod.f90 | 486 ++++++----------------- models/aether_lon-lat/model_mod.nml | 2 +- 3 files changed, 122 insertions(+), 380 deletions(-) diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index 6ecb7dd7ca..8ab3669c61 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -41,7 +41,6 @@ program aether_to_dart character(len=32 ), parameter :: revision = "$Revision$" character(len=128), parameter :: revdate = "$Date$" -character(len=512) :: string1, string2 character(len=*), parameter :: program_name = 'aether_to_dart' ! !----------------------------------------------------------------------- @@ -61,23 +60,12 @@ program aether_to_dart ! global storage !---------------------------------------------------------------------- -integer :: iunit, io, member +integer :: member !====================================================================== call initialize_utilities(program_name) -! !---------------------------------------------------------------------- -! ! Read the namelist -! !---------------------------------------------------------------------- -! -! call find_namelist_in_file("input.nml", "aether_to_dart_nml", iunit) -! read(iunit, nml = aether_to_dart_nml, iostat = io) -! call check_namelist_read(iunit, io, "aether_to_dart_nml") ! closes, too. -! -! ! error-check, convert namelist input to variable_table, and build the state structure -! call make_variable_table() - !---------------------------------------------------------------------- ! Get the ensemble member ! TODO: The script must echo the member number to the aether_to_dart. diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 53b10b2169..41a9fd4bd0 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -24,12 +24,12 @@ module model_mod !------------------------------------------------------------------------------- ! -! Interface for HAO-TIEGCM 2.0 +! Interface for Aether ! !------------------------------------------------------------------------------- use types_mod, only : r4, r8, i8, MISSING_R8, MISSING_R4, PI, RAD2DEG, & - earth_radius, gravity, obstypelength, MISSING_I + earth_radius, gravity, MISSING_I use time_manager_mod, only : time_type, set_calendar_type, set_time_missing, & set_time, get_time, print_time, & @@ -164,7 +164,7 @@ module model_mod integer :: debug = 0 logical :: estimate_f10_7 = .false. character(len=256) :: f10_7_file_name = 'f10_7.nc' -real(r8) :: model_res = 5.0_r8 +real(r8) :: model_res = 5.0_r8 ! TODO VTEC calculations, but res shouldn't be hardwired ! TODO: confirm that the units are days. ! Better to get the actual start day of Aether's calender. @@ -203,6 +203,7 @@ module model_mod namelist /aether_to_dart_nml/ aether_restart_dirname, filter_io_root, variables +!----------------------------------------------------------------------- ! dart_to_aether namelist parameters with default values. !----------------------------------------------------------------------- @@ -219,9 +220,6 @@ module model_mod integer :: nalt, nlon, nlat, nilev real(r8),dimension(:), allocatable :: lons, lats, alts, plevs, ilevs ! HK are plevs, pilevs per ensemble member? -real(r8) :: TIEGCM_reference_pressure -integer :: time_step_seconds -integer :: time_step_days type(time_type) :: time_step type(quad_interp_handle) :: quad_interp @@ -297,7 +295,6 @@ module model_mod subroutine static_init_model() -integer :: iunit, io character(len=*), parameter :: routine = 'static_init_model' character(len=128) :: aether_filename @@ -383,32 +380,32 @@ function block_file_name(filetype, memnum, blocknum) integer, intent(in) :: blocknum integer, intent(in) :: memnum character(len=128) :: block_file_name +character(len=*), parameter :: routine = 'block_file_name' block_file_name = trim(filetype) if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum block_file_name = trim(block_file_name)//'.nc' -! TODO: Convert print to the error handler -print*,'filename, memnum, blocknum = ' ,trim(block_file_name), memnum, blocknum +if ( debug > 0 ) then + write(string1,'("filename, memnum, blocknum = ",A,2(1x,i5))') & + trim(block_file_name), memnum, blocknum + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif end function block_file_name !================================================================== !> Converts Aether restart files to a netCDF file -!> Modified from models/gitm/model_mod.f90 !> !> This routine needs: !> !> 1. A base dirname for the restart files (restart_dirname). -!> they will have the format 'dirname/bNNNN.rst' where NNNN has -!> leading 0s and is the block number. Blocks start in the +!> they will have the format 'dirname/{neutrals,ions}_mMMMM_gBBBB.rst' +!> where BBBB is the block number, MMMM is the member number, +!> and they have leading 0s. Blocks start in the !> southwest corner of the lat/lon grid and go east first, !> then to the west end of the next row north and end in the northeast corner. -!> The other info is in 'dirname/header.rst' !> -!> 2. The name of the output file to store the netCDF variables -!> (netcdf_output_file) -!> !> In the process, the routine will find: !> !> 1. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. @@ -424,14 +421,9 @@ end function block_file_name !> !> 5. The number of ion species (ditto - numbers <-> names) (nIons) !> -!> We assume that the 'UseTopography' flag is false - that all columns -!> have the same altitude arrays. This is true on earth but not on -!> other planets. -!> -!> In addition to reading in the state data, it fills Longitude, -!> Latitude, and Altitude arrays with the grid spacing. This grid -!> is orthogonal and rectangular but can have irregular spacing along -!> any or all of the three dimensions. +!> In addition to reading in the state data, it fills Longitude, Latitude, and Altitude arrays. +!> This grid is orthogonal and rectangular but can have irregular spacing along +!> any of the three dimensions. subroutine restart_files_to_netcdf(member) @@ -460,17 +452,13 @@ subroutine restart_files_to_netcdf(member) call error_handler(E_MSG, routine, string1, text2=string2) call error_handler(E_MSG, '', '') -! DONE: This should probably be replaced by nc_write_model_atts(ncid). -! That may require renaming some dimension variables. -! call add_nc_definitions(ncid) ! Enters and exits define mode; call nc_write_model_atts(ncid, 0) call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) ! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts -! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying -! the state vector field names and source. +! but maybe it shouldn't be. ! call add_nc_dimvars(ncid) call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) @@ -500,10 +488,8 @@ subroutine netcdf_to_restart_files(member) integer :: ncid character(len=*), parameter :: routine = 'netcdf_to_restart_files:' -! sort the required fields into the order they exist in the -! binary restart files and write out the state vector data -! field by field. when this routine returns all the data has -! been written. +! write out the state vector data. +! when this routine returns all the data has been written. if (module_initialized ) then write(string1,*)'The gitm mod was already initialized but ',trim(routine),& @@ -1081,7 +1067,7 @@ function read_model_time(filename) type(time_type) :: read_model_time character(len=*), intent(in) :: filename -integer :: ncid, i, ios +integer :: ncid integer :: tsimulation ! the time read from a restart file; seconds from aeth_ref_date. integer :: ndays,nsecs @@ -1135,8 +1121,8 @@ end function read_model_time subroutine make_variable_table() integer :: nfields_constructed ! number of constructed state variables - -integer :: i, nrows, ncols +integer :: i, nrows, ncols +character(len=*), parameter :: routine = 'read_model_time' character(len=NF90_MAX_NAME) :: varname character(len=NF90_MAX_NAME) :: dartstr @@ -1211,9 +1197,15 @@ subroutine make_variable_table() else if (trim(variable_table(i,VT_ORIGININDX)) == 'CALCULATE') then nfields_constructed = nfields_constructed + 1 else - print*,'variable_table(',i, VT_ORIGININDX,') = ', trim(variable_table(i,VT_ORIGININDX)) + write(string1,'(A,2i5,2A)')'variable_table(',i, VT_ORIGININDX,') = ', & + trim(variable_table(i,VT_ORIGININDX)) + call error_handler(E_ERR,routine,string1,source,revision,revdate) + endif + if ( debug > 0 ) then + write(string1,'("make_variable_table: nfields = ",3(1x,i5))') & + nfields, nfields_neutral, nfields_ion + call error_handler(E_MSG,routine,string1,source,revision,revdate) endif - print*,'make_variable_table: nfields = ',nfields, nfields_neutral, nfields_ion enddo ROWLOOP @@ -1285,8 +1277,7 @@ subroutine static_init_blocks(nml) character(len=*), parameter :: routine = 'static_init_blocks' -character(len=NF90_MAX_NAME) :: varname -integer :: iunit, io, ivar +integer :: iunit, io !logical :: has_gitm_namelist if (module_initialized) return ! only need to do this once @@ -1321,7 +1312,7 @@ subroutine static_init_blocks(nml) call make_variable_table() !--------------------------------------------------------------- -! Set the time step ... causes gitm namelists to be read. +! TODO: Set the time step ! Ensures model_advance_time is multiple of 'dynamics_timestep' !TODO: Aether uses Julian time internally @@ -1335,7 +1326,6 @@ subroutine static_init_blocks(nml) call get_grid_info_from_blocks(aether_restart_dirname, nlon, nlat, nalt, nBlocksLon, & nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) -print*,'static_init_blocks: post-get_grid_info_from_blocks; nfields_neutral = ', nfields_neutral if( debug > 0 ) then write(string1,*) 'grid dims are ',nlon,nlat,nalt @@ -1356,25 +1346,7 @@ subroutine static_init_blocks(nml) aether_filename = block_file_name(variable_table(1,VT_ORIGININDX), 0, 0) state_time = read_model_time(trim(aether_restart_dirname)//'/'//trim(aether_filename)) -! TODO: Replace with aether variables check? (OR is that done when trying to read them?) -! call verify_block_variables( gitm_block_variables, nfields ) -! -! do ivar = 1, nfields -! -! varname = trim(gitm_block_variables(ivar)) -! gitmvar(ivar)%varname = varname -! -! ! This routine also checks to make sure user specified accurate GITM variables -! call decode_gitm_indices( varname, & -! gitmvar(ivar)%gitm_varname, & -! gitmvar(ivar)%gitm_dim, & -! gitmvar(ivar)%gitm_index, & -! gitmvar(ivar)%long_name, & -! gitmvar(ivar)%units) -! if ( debug > 0 ) then -! call print_gitmvar_info(ivar,routine) -! endif -! enddo +! TODO: Replace verify_block_variables+decode_gitm_indices with aether variables check? (OR is that done when trying to read them from NetCDF?) if ( debug > 0 ) then write(string1,'("grid: nlon, nlat, nalt =",3(1x,i5))') nlon, nlat, nalt @@ -1589,7 +1561,7 @@ function aeth_name_to_dart(varname) var_root = aeth(char_num+1:aeth_len) ! purge_chars removes unwanted [()\] parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) -print*,'var_root, parts(1) = ',var_root, parts(1) +! print*,'var_root, parts(1) = ',var_root, parts(1) end_str = char_num ! Tranform remaining pieces of varname into DART versions. @@ -1638,13 +1610,10 @@ function purge_chars(ugly_string, chars, plus_minus) ! Trim is not needed here temp_str = ugly_string end_str = len_trim(temp_str) -print*,'len_trim(str), ugly_string = ',end_str, ugly_string,'||end' -print*,'temp_str = ',temp_str,'||end' char_num = MISSING_I do ! Returns 0 if chars are not found char_num = scan(temp_str,chars) - print*,'char_num, temp_str = ',char_num, trim(temp_str) ! Need to change it to a char that won't be found by scan in the next iteration, ! and can be easily removed. if (char_num > 0) then @@ -1692,7 +1661,7 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & real(r8), allocatable , dimension( : ), intent(inout) :: lons, lats, alts -integer :: ios, nb, offset, ncid, nboff +integer :: nb, offset, ncid, nboff character(len=128) :: filename real(r4), allocatable :: temp(:,:,:) integer :: starts(3),ends(3), xcount, ycount, zcount @@ -1746,9 +1715,9 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & allocate(temp( 1:nzPerBlock, & 1-nGhost:nyPerBlock+nGhost, & 1-nGhost:nxPerBlock+nGhost)) +! TODO; use MISSING_R4 instead? temp = -888888. -print*,'shape of temp = ',shape(temp) starts(1) = 1-nGhost starts(2) = 1-nGhost @@ -1759,9 +1728,11 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & xcount = nxPerBlock + 2*nGhost ycount = nyPerBlock + 2*nGhost zcount = nzPerBlock -print*,'starts = ',starts -print*,'ends = ',ends -print*,'counts = ',xcount,ycount,zcount +if ( debug > 0 ) then + write(string1,'(3(A,i5),2(1X,i5))') & + 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount + call error_handler(E_MSG,routine,string1,source,revision,revdate) +endif ! go across the south-most block row picking up all longitudes do nb = 1, nBlocksLon @@ -1778,16 +1749,6 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & context=routine, & nc_count=(/zcount,ycount,xcount/)) -! TODO: nc_get_variable stops on error conditions, does not pass back ios. -! if ( ios /= 0 ) then -! print *,'size:',size(temp(1-nGhost:nxPerBlock+nGhost)) -! print *,'IO error code:',ios -! write(string1,*)'ERROR reading file ', trim(filename) -! write(string2,*)'longitude block ',nb,' of ',nBlocksLon -! call error_handler(E_ERR,'get_grid',string1, & -! source,revision,revdate,text2=string2) -! endif - offset = (nxPerBlock * (nb - 1)) lons(offset+1:offset+nxPerBlock) = temp(1,1,1:nxPerBlock) @@ -1807,12 +1768,6 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & context=routine, nc_count=(/zcount,ycount,xcount/)) -! if ( ios /= 0 ) then -! write(string1,*)'ERROR reading file ', trim(filename) -! write(string2,*)'latitude block ',nb,' of ',nBlocksLat -! call error_handler(E_ERR,'get_grid',string1, & -! source,revision,revdate,text2=string2) -! endif offset = (nyPerBlock * (nb - 1)) lats(offset+1:offset+nyPerBlock) = temp(1,1:nyPerBlock,1) @@ -1821,10 +1776,6 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & enddo -! this code assumes UseTopography is false - that all columns share -! the same altitude array, so we can read it from the first block. -! if this is not the case, this code has to change. - filename = block_file_name('grid', -1, 0) ncid = open_block_file(filename, 'read') @@ -1834,8 +1785,6 @@ subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & context=routine, nc_count=(/zcount,ycount,xcount/)) alts(1:nzPerBlock) = temp(1:nzPerBlock,1,1) -! print*,'temp = ',temp(:,1,1) -! print*,'alts = ',alts call nc_close_file(ncid) @@ -1904,38 +1853,6 @@ function open_block_file(filename,rw) end function open_block_file !================================================================= - -subroutine verify_block_variables( variable_array, ngood) - -character(len=*), dimension(:), intent(in) :: variable_array -integer, intent(out) :: ngood - -integer :: nrows, i -character(len=NF90_MAX_NAME) :: varname - -character(len=*), parameter :: routine = 'verify_state_variables' - -nrows = size(variable_array,1) - -ngood = 0 -MyLoop : do i = 1, nrows - - varname = variable_array(i) - - if ( varname == ' ') exit MyLoop ! Found end of list. - - ngood = ngood + 1 -enddo MyLoop - -if (ngood == nrows) then - string1 = 'WARNING: There is a possibility you need to increase ''max_state_variables''' - write(string2,'(''WARNING: you have specified at least '',i4,'' perhaps more.'')')ngood - call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2) -endif - -end subroutine verify_block_variables - -!================================================================== ! ! subroutine add_nc_definitions(ncid) ! @@ -2023,10 +1940,7 @@ subroutine restarts_to_filter(dirname, ncid_output, member, define) logical, intent(in) :: define integer :: ibLoop, jbLoop -integer :: ib, jb, nb, iunit - -character(len=256) :: filename - +integer :: ib, jb if (define) then ! if define, run one block. @@ -2042,7 +1956,6 @@ subroutine restarts_to_filter(dirname, ncid_output, member, define) jbLoop = nBlocksLat end if -print*,'restarts_to_filter: define = ',define do jb = 1, jbLoop do ib = 1, ibLoop @@ -2074,8 +1987,8 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) -real(r4) :: temp0d !Alex: single parameter has "zero dimensions" -integer :: i, j, maxsize, ivar, nb, ncid_input +real(r4) :: temp0d !Alex: single parameter has "zero dimensions" TODO f107? +integer :: i, j, ivar, nb, ncid_input !i,j, maybe for TEC calc integer :: block(2) = 0 logical :: no_idensity @@ -2091,10 +2004,6 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! Lower left is 0, increase to the East, then 1 row farther north, West to East. nb = (jb-1) * nBlocksLon + ib - 1 -! a temp array large enough to hold any of the -! Lon,Lat or Alt array from a block plus ghost cells -allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) - ! treat alt specially since we want to derive TEC here ! TODO: See density_ion_e too. allocate( alt1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) @@ -2117,51 +2026,12 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) 1-nGhost:nyPerBlock+nGhost, & 1-nGhost:nxPerBlock+nGhost)) -! Aether gives a unique name to each (of 6) velocity components -! ! temp array large enough to hold velocity vect, etc -! maxsize = max(3, nSpecies) -! allocate(temp4d(1-nGhost:nxPerBlock+nGhost, & -! 1-nGhost:nyPerBlock+nGhost, & -! 1-nGhost:nzPerBlock+nGhost, maxsize)) ! TODO; Does Aether need a replacement for these Density fields? Yes. ! But they are probably read by the loops below. ! Don't need to fetch index because Aether has NetCDF restarts, ! so just loop over the field names to read. -! Read the index from the first species -! call get_index_from_gitm_varname('NDensityS', inum, ivals) - -! if (inum > 0) then -! ! if i equals ival, use the data from the state vect -! ! otherwise read/write what's in the input file -! j = 1 -! do i = 1, nSpeciesTotal -! if (debug > 80) then -! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading species ',i,' of ',nSpeciesTotal, & -! ' for block (',ib,',',jb,')' -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! read(iunit) temp3d -! if (j <= inum) then -! if (i == gitmvar(ivals(j))%gitm_index) then -! call write_filter_io(temp3d, ivals(j), block, ncid) -! j = j + 1 -! endif -! endif -! enddo -! else -! if (debug > 80) then -! write(string1,'(A)') 'Not writing the NDensityS variables to file' -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! ! nothing at all from this variable in the state vector. -! ! copy all data over from the input file to output file -! do i = 1, nSpeciesTotal -! read(iunit) temp3d -! enddo -! endif -! ! call get_index_from_gitm_varname('IDensityS', inum, ivals) ! ! ! assume we could not find the electron density for VTEC calculations @@ -2214,12 +2084,15 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) filename = block_file_name(file_root, member, nb) ncid_input = open_block_file(filename, 'read') -print*,'block_to_filter_io: nfields_neutral = ',nfields_neutral do ivar = 1, nfields_neutral ! TODO: the nf90 functions cannot read the variable names with the '\'s in them. ! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) - print*,routine,'varname = ',varname +! TODO: Convert print to the error handler with conditional + if ( debug > 0 ) then + write(string1,'("varname = ",A)') varname + call error_handler(E_MSG,routine,string1,source,revision,revdate) + endif ! NEWIC; ! Translate the Aether field name into a DART field name. dart_varname = aeth_name_to_dart(varname) @@ -2237,7 +2110,10 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) call nc_define_real_variable(ncid_output, dart_varname, & (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) - print*,routine,': defined ivar, dart_varname = ', ivar, dart_varname + if ( debug > 0 ) then + write(string1,'("defined ivar, dart_varname = ",i5,1x,A)') ivar, trim(dart_varname) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + endif ! TODO: does the filter_input.nc file need all these attributes? TIEGCM doesn't add them. ! They are not available from the restart files. ! Add them to the ions section too. @@ -2253,8 +2129,13 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! Read 3D array and extract the non-halo data of this block. ! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. call nc_get_variable(ncid_input, varname, temp3d, context=routine) - print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),varname - print*,'block_to_filter_io: define = ',define +! TODO: Convert print to the error handler with conditional + if ( debug > 0 ) then + write(string1,'(3A,L,A,1p2e13.5)') 'varname = ',trim(varname), ', define = ',define, & + ', temp3d = ',temp3d(1,1,1),temp3d(15,15,15) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + endif + call write_filter_io(temp3d, dart_varname, block, ncid_output) else write(string1,*) 'Trying to read neutrals, but variable_table(',ivar,VT_ORIGININDX, & @@ -2269,14 +2150,11 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) filename = block_file_name(file_root, member, nb) ncid_input = open_block_file(filename, 'read') -print*,'block_to_filter_io: nfields_ion = ',nfields_ion do ivar = nfields_neutral +1,nfields_neutral + nfields_ion ! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) - print*,'Purging \ from aether name' varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) ! NEWIC; ! Translate the Aether field name into a DART field name. - print*,'Converting aether name ',trim(varname) dart_varname = aeth_name_to_dart(varname) if (define) then @@ -2288,7 +2166,10 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) call nc_define_real_variable(ncid_output, dart_varname, & (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) - print*,routine,': defined ivar, dart_varname = ', ivar, dart_varname + if ( debug > 0 ) then + write(string1,'("defined ivar, dart_varname = ",i5,2x,A)') ivar, trim(dart_varname) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + endif else if (file_root == 'ions') then call nc_get_variable(ncid_input, varname, temp3d, context=routine) @@ -2341,7 +2222,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! endif !print *, 'calling dealloc' -deallocate(temp1d, temp2d, temp3d) +deallocate(temp2d, temp3d) deallocate(alt1d, density_ion_e) end subroutine block_to_filter_io @@ -2455,7 +2336,6 @@ subroutine write_filter_io(data3d, varname, block, ncid) integer :: starts(3) character(len=*), parameter :: routine = 'write_filter_io' -print*,routine,': data3d = ',data3d(1,1,1),data3d(15,15,15) ! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) @@ -2471,7 +2351,6 @@ subroutine write_filter_io(data3d, varname, block, ncid) data3d(1:nzPerBlock,1:nyPerBlock,1:nxPerBlock), & context=routine, nc_start=starts, & nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) -print*,routine,': filled varname = ', varname end subroutine write_filter_io @@ -2508,14 +2387,17 @@ subroutine filter_to_restarts(ncid, member) ! should have its halo filled. do ivar = 1, nfields_neutral varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) - print*,routine,'varname = ',varname +! TODO: Convert print to the error handler with conditional + if ( debug > 0 ) then + write(string1,'("varname = ",A)') trim(varname) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + endif ! NEWIC; ! Translate the Aether field name into a DART field name. dart_varname = aeth_name_to_dart(varname) file_root = trim(variable_table(ivar,VT_ORIGININDX)) if (file_root == 'neutrals') then - ! fulldom3d = MISSING_R4 ! Assuming that this parameter is available through the `use netcdf` command. fulldom3d = NF90_FILL_REAL call nc_get_variable(ncid, dart_varname, fulldom3d(1:nalt,1:nlat,1:nlon), & @@ -2540,8 +2422,12 @@ subroutine filter_to_restarts(ncid, member) dart_varname = aeth_name_to_dart(varname) file_root = trim(variable_table(ivar,VT_ORIGININDX)) - print*,routine,': varname, dart_varname, file_root = ', & - trim(varname), trim(dart_varname), file_root +! TODO: Convert print to the error handler with conditional + if ( debug > 0 ) then + write(string1,'("varname, dart_varname, file_root = ",3(2x,A))') & + trim(varname), trim(dart_varname), file_root + call error_handler(E_MSG,routine,string1,source,revision,revdate) + endif if (file_root == 'ions') then fulldom3d = NF90_FILL_REAL @@ -2632,37 +2518,42 @@ subroutine add_halo_fulldom3d(fulldom3d) ! to see whether values are copied correctly ! Level 44 values range from 800-eps to 805. I don't want to see the 80. ! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. -if (fulldom3d(44,10,10) > 1.e+10) then - normed = fulldom3d(44,:,:) - 1.1092e+10 - debug_format = '(3(4E10.4,2X))' -else if (fulldom3d(44,10,10) < 1000._r4) then - normed = fulldom3d(44,:,:) - 800._r4 - debug_format = '(3(4F10.5,2X))' +! TODO: Convert print to the error handler with conditional +if ( debug > 0 ) then + if (fulldom3d(44,10,10) > 1.e+10) then + normed = fulldom3d(44,:,:) - 1.1092e+10 + debug_format = '(3(4E10.4,2X))' + else if (fulldom3d(44,10,10) < 1000._r4) then + normed = fulldom3d(44,:,:) - 800._r4 + debug_format = '(3(4F10.5,2X))' + endif + + ! Debug HDF5 + write(string1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))'),normed(nlat+1,nlon+2) + call error_handler(E_MSG,routine,string1,source,revision,revdate) + + ! 17 format debug_format + print*,'top' + do j = nlat+2,nlat-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) + enddo + print*,'middle' + do j = haflat+2,haflat-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) + enddo + print*,'bottom' + do j = 2,-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) + enddo +! TODO: end normed debug conditional section. endif -! Debug HDF5 -print*,'normed_field(10,nlat+1,nlon+2) = ',normed(nlat+1,nlon+2) - -! 17 format debug_format -print*,'top' -do j = nlat+2,nlat-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) -enddo -print*,'middle' -do j = haflat+2,haflat-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) -enddo -print*,'bottom' -do j = 2,-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) -enddo - deallocate(normed) end subroutine add_halo_fulldom3d @@ -2683,7 +2574,6 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) ! Don't collect velocity components (6 of them) ! real(r4) :: temp0d ! , temp1d(:) ? -! , temp4d(:,:,:,:), integer :: ncid_output integer :: ib, jb, nb integer :: starts(3),ends(3), xcount, ycount, zcount @@ -2694,19 +2584,10 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) ! Lon,Lat or Alt array from a block plus ghost cells ! allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) - -print*,routine,'; How long is varname after passing to a subroutine? ',varname,' end' - zcount = nzPerBlock ycount = nyPerBlock + 2*nGhost xcount = nxPerBlock + 2*nGhost -! temp array large enough to hold velocity vect, etc -! TODO: Aether has 6 velocity components, but we're treating them -! as unrelated fields for reading and writing (for now). -! maxsize = max(3, nSpecies) -! allocate(temp4d(1-nGhost:nxPerBlock+nGhost, 1-nGhost:nyPerBlock+nGhost, & -! 1-nGhost:nzPerBlock+nGhost, maxsize)) if (debug > 0) then write(string1,'(A,I0,A,I0,A)') 'Now putting the data for ',nBlocksLon, & @@ -2732,12 +2613,13 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) ! TODO: error checking; does the block file have the field in it? - print*,' ' - print*,'block, ib, jb = ',nb, ib, jb - print*,'starts = ',starts - print*,'ends = ',ends - print*,'counts = ',xcount,ycount,zcount - + if ( debug > 0 ) then + write(string1,'(/,"block, ib, jb = ", 3(2X,i5))') nb, ib, jb + call error_handler(E_MSG,routine,string1,source,revision,revdate) + write(string1,'(3(A,i5),2(1X,i5))') & + 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount + call error_handler(E_MSG,routine,string1,source,revision,revdate) + endif call nc_put_variable(ncid_output, trim(varname), & fulldom3d(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & @@ -2748,27 +2630,6 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) enddo enddo -! !print *, 'reading in temp4d for ivel' -! read(iunit) temp4d(:,:,:,1:3) -! call get_index_from_gitm_varname('IVelocity', inum, ivals) -! if (inum > 0) then -! ! one or more items in the state vector need to replace the -! ! data in the output file. loop over the index list in order. -! j = 1 -! do i = 1, 3 -! if (j <= inum) then -! if (i == gitmvar(ivals(j))%gitm_index) then -! print *,'now writing:',trim(gitmvar(ivals(j))%varname) -! ! read from input but write from state vector -! data3d = temp4d(:,:,:,i) -! call read_filter_io_block(ncid, ivals(j), block, data3d) -! temp4d(:,:,:,i) = data3d -! j = j + 1 -! endif -! endif -! enddo -! endif -! write(ounit) temp4d(:,:,:,1:3) ! ! !alex begin: added f107 and Rho to the restart files: ! read(iunit) temp0d @@ -2786,115 +2647,6 @@ end subroutine filter_io_to_blocks !================================================================== -! put the state vector data into a 3d array - -subroutine read_filter_io_block(ncid, ivar, block, data3d) - -integer, intent(in) :: ncid -integer, intent(in) :: ivar ! index into state structure -integer, intent(in) :: block(2) -real(r8), intent(inout) :: data3d(1:nzPerBlock, & - 1-nGhost:nxPerBlock+nGhost, & - 1-nGhost:nyPerblock+nGhost) -integer :: ib, jb -integer :: starts(3) -integer :: ends(3) -integer :: local_starts(3) -integer :: local_ends(3) -integer :: counts(3) -integer :: maxvals(3) -integer :: i, j - -character(len=*), parameter :: routine = 'read_filter_io_block' -character(len=NF90_MAX_NAME) :: varname - -write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) - -ib = block(1) -jb = block(2) - -! to compute the start, consider (ib-1)*nxPerBlock+1 -starts(1) = (ib-1)*nxPerBlock + 1 - nGhost - ends(1) = ib*nxPerBlock + nGhost -starts(2) = (jb-1)*nyPerBlock + 1 - nGhost - ends(2) = jb*nyPerBlock + nGhost -starts(3) = 0 + 1 - ends(3) = nzPerBlock - -maxvals = (/nlon,nlat,nalt/) - -! KDR It looks like blocks bordering the dateline do not have halos on the dateline edge. -do i=1,2 - if (starts(i) < 1) then - starts(i) = 1 - local_starts(i) = 1 - else - local_starts(i) = 1-nGhost - end if -end do -local_starts(3) = 1 - -do i=1,3 - if (ends(i) > maxvals(i)) then - ends(i) = maxvals(i) - end if -end do - -counts = ends-starts+1 - -local_ends = local_starts + counts - 1 - -if (debug > 10) then - if (ivar == 1) then - write(string1,'(12(A,I0),A)') 'Now reading netCDF indices (',starts(1),':',ends(1),') and (',starts(2),':',ends(2),') ' // & - 'in the block (',ib,',',jb,') for local (',local_starts(1),':',local_ends(1),') and (',& - local_starts(2),':',local_ends(2),') for size (',counts(1),',',counts(2),')' - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if -end if - -if (debug > 200) then - ! KDR; in GITM this assumed this is being called to "pack" the dimensions - ! and the user wanted to see level 3 of ivar=3 (Altitude) (?). - ! This is upgraded to explicitly check for the variable name. - ! Untested. - if (varname == 'Altitude') then - print *,'before reading:' - do i=1-nGhost,nxPerBlock+nGhost - do j=1-nGhost,nyPerBlock+nGhost - write(*,'(A,A,I0,A,I0,A,F8.3)') trim(varname), & - ' at level 3 (',i,',',j,'): ',data3D(3,j,i) - end do - end do - end if -end if - -! KDR starts and ends include the halo. -! Halos were not written explicitly to the DART netcdf file -! but the data is there; a complete state vector, -! so we can grab halos and central subdomains from it. -call nc_get_variable(ncid, varname, & - data3d(local_starts(3):local_ends(3), & - local_starts(2):local_ends(2), & - local_starts(1):local_ends(1)), & - context="read_filter_io_block", nc_start=starts, nc_count=counts) - -if (debug > 200) then - if (varname == 'Altitude') then - print *,'after reading:' - do i=1-nGhost,nxPerBlock+nGhost - do j=1-nGhost,nyPerBlock+nGhost - write(*,'(A,A,I0,A,I0,A,F8.3)') trim(varname), & - ' at level 3 (',i,',',j,'): ',data3D(3,j,i) - end do - end do - end if -end if - -end subroutine read_filter_io_block - - -!================================================================== !> put the f107 estimate (scalar) from the statevector into a 0d container !> the only trick this routine does is give all blocks the same f107 (the @@ -2924,8 +2676,10 @@ end subroutine read_filter_io_block0d !================================================================== ! +! TODO: Leaving load_up_state_structure_from_file here until we know how we'll handle +! TEC, f107, ...? ! ! Adds a domain to the state structure from a netcdf file -! ! Called from make_variable_table +! ! Called from make_variable_table for derived variables. ! subroutine load_up_state_structure_from_file(filename, nvar, domain_name, domain_num) ! ! character(len=*), intent(in) :: filename ! filename to read from diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index f2f2070730..bcec24c00a 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -1,6 +1,6 @@ &model_nml debug = 100 - filter_io_dir = 'testdata1/restartOut.Sphere.1member' + filter_io_dir = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata2' estimate_f10_7 = .false. f10_7_file_name = 'f10_7.nc' variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', From ccafc7b766aea3063f000b4fbf8d3c20aae66a67 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 29 Dec 2023 18:28:36 -0700 Subject: [PATCH 056/124] Merged model_mod versions used for *_to_* and interpolation Ben merged the model_mod used to develop aether_to_dart and dart_to_aether into the model_mod developed to do the filter tasks; interpolation, ... That was developed from the model_mod template, with changes to comply with the DART style manual, so there are many non-algorithm differences from the previous *_to_* model mod committed to branch 'aether'. The merged version from Ben didn't quite pass model_mod_check. Besides the cosmetic changes, this merged version: + Reads variables (2D array) directly from namelist; no variable_table. + Fixes the dimension order in 'variables' to be (cols,fields) so that values from the namelist will be read correctly. + Made variables() have 6 columns, to include the source file root. + Replaced lengths of variables()' strings and related variables with types_mod:vtablenamelength (instead of NF90_MAX_NAME) + Replaced hard-coded dimension names 'lon', 'lat', 'z' with already defined parameters {LON,LAT,LEV}_{DIM,VAR}_NAME. + Added do_output() conditionals around messages in the *_to_* procedures. + Removed: - not-yet-used code dealing with TEC and f10.7, - routines from TIEGCM which are not needed, - suggestion of a derived type to handle the various file types, + Added the time (UNLIMITED) dimension and variable to filter*.nc files. Misguidedly, this was done by adding 'time' to nc_write_model_atts, which works fine for aether_to_dart to create filter_input files. But it breaks model_mod_check, because create_and_open_state_output also defines the time dimension (also UNLIMITED), which is not allowed. So it seems that in aether_to_dart we need to replace the direct use of nc_write_model_atts for creating filter_input.nc. Instead, define a domain (add_domain_from_file, since I have a filter_input with the right dimensions), which is then used by a new call to write_state (... create_and_open_state_output) Model_mod_check, aether_to_dart, and dart_to_aether all compile. Aether_to_dart and dart_to_aether work, but see "time", above. aether_to_dart.f90 Removed unneeded 'use' procedures aether_to_dart.nml, dart_to_aether.nml Added debug model_mod.f90 See above model_mod.nml Removed f10_7 variables, calendar. filter_io_dir -> filter_io_filename (should probably be filter_io_root) assimilation_period_seconds -> time_step_{days,seconds} Replaced Aether O+ with DART's Opos transform_names.f90 New program to test code to make variable names CF compliant work/input.nml See model_mod.nml replaced model_mod_check_nml contents with current and Aether variables work/input.nml work/quickbuild.sh added transform names --- models/aether_lon-lat/aether_to_dart.f90 | 3 - models/aether_lon-lat/aether_to_dart.nml | 1 + models/aether_lon-lat/dart_to_aether.nml | 1 + models/aether_lon-lat/model_mod.f90 | 4783 +++++++++------------ models/aether_lon-lat/model_mod.nml | 97 +- models/aether_lon-lat/transform_names.f90 | 134 + models/aether_lon-lat/work/input.nml | 81 +- models/aether_lon-lat/work/quickbuild.sh | 3 +- 8 files changed, 2182 insertions(+), 2921 deletions(-) create mode 100644 models/aether_lon-lat/transform_names.f90 diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index 8ab3669c61..d3f75de5db 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -26,13 +26,10 @@ program aether_to_dart use types_mod, only : r8 use utilities_mod, only : initialize_utilities, finalize_utilities, & - find_namelist_in_file, check_namelist_read, & error_handler, E_MSG use model_mod, only : restart_files_to_netcdf -use time_manager_mod, only : time_type, print_time, print_date - implicit none ! version controlled file description for error handling, do not edit diff --git a/models/aether_lon-lat/aether_to_dart.nml b/models/aether_lon-lat/aether_to_dart.nml index 1e982e1b1a..01ba8e0a07 100644 --- a/models/aether_lon-lat/aether_to_dart.nml +++ b/models/aether_lon-lat/aether_to_dart.nml @@ -21,6 +21,7 @@ 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' + debug = 0 / ! TODO: Or could use these. What's the difference? diff --git a/models/aether_lon-lat/dart_to_aether.nml b/models/aether_lon-lat/dart_to_aether.nml index 0b2562025c..a42a6dd6c8 100644 --- a/models/aether_lon-lat/dart_to_aether.nml +++ b/models/aether_lon-lat/dart_to_aether.nml @@ -21,6 +21,7 @@ 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' + debug = 0 / ! 4 digit member number and .nc will be appended to this. diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 41a9fd4bd0..e0b15627b9 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -1,24 +1,7 @@ ! 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 module was copied from models/tiegcm -! but has restart reading and writing routines from ../gitm, -! because the lon-lat grid layout, with halos, and subdomain ("block") file structure -! seems to be the same in GITM and Aether, -! Those subroutines need to be adapted to the infrastructure in this model_mod -! and to the Aether restart files' format and contents. -! Later they will be exported to a model_mod Ben is developing from scratch. - -! The model_mod.nml initially has the namelists from both tiegcm and gitm. -! Parts of both may be useful and will be merged into a new aether_lon-lat nml. - -! The module is organized into sections: -! Routines in this section (down to "private") are public. -! Routines below here are private to the module -! Routines for initialization. -! Routines for aether_to_dart. -! Routines for dart_to_aether. +! module model_mod @@ -28,170 +11,114 @@ module model_mod ! !------------------------------------------------------------------------------- -use types_mod, only : r4, r8, i8, MISSING_R8, MISSING_R4, PI, RAD2DEG, & - earth_radius, gravity, MISSING_I - -use time_manager_mod, only : time_type, set_calendar_type, set_time_missing, & - set_time, get_time, print_time, & - set_date, get_date, print_date, & - operator(*), operator(+), operator(-), & - operator(>), operator(<), operator(/), & - operator(/=), operator(<=) - -use location_mod, only : location_type, & - get_close_obs, & -! TODO: need this from Ben's model_mod - loc_get_close_state => get_close_state, & - set_location, get_location, & - get_dist, query_location, & - get_close_type, VERTISUNDEF, & - VERTISPRESSURE, VERTISHEIGHT, VERTISLEVEL, & - vertical_localization_on, set_vertical - -use utilities_mod, only : open_file, file_exist, close_file, logfileunit, & - error_handler, E_ERR, E_MSG, E_WARN, nmlfileunit, & - do_output, find_namelist_in_file, check_namelist_read, & - do_nml_file, do_nml_term, register_module, & - file_to_text, find_textfile_dims, to_upper - -! TODO: will need many more kinds, and maybe new kinds (6 velocity components, ...?) -use obs_kind_mod, only : QTY_U_WIND_COMPONENT, & - QTY_V_WIND_COMPONENT, & - QTY_TEMPERATURE, &! neutral temperature obs - QTY_PRESSURE, &! neutral pressure obs - QTY_MOLEC_OXYGEN_MIXING_RATIO, &! neutral composition obs - QTY_1D_PARAMETER, & - QTY_GEOPOTENTIAL_HEIGHT, & - QTY_GEOMETRIC_HEIGHT, & - QTY_VERTICAL_TEC, &! total electron content - QTY_DENSITY_ION_OP, &! O+ - get_index_for_quantity - -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 mpi_utilities_mod,only : my_task_id - -use default_model_mod, only : adv_1step, & - init_conditions => fail_init_conditions, & - init_time => fail_init_time, & - nc_write_model_vars, & - pert_model_copies - -use state_structure_mod, only : add_domain, get_dart_vector_index, add_dimension_to_variable, & - finished_adding_domain, state_structure_info, & - get_domain_size, get_model_variable_indices, & - get_num_dims, get_dim_name, get_variable_name, & - get_varid_from_varname, get_num_varids_from_kind, & - get_varid_from_kind, get_varids_from_kind, & - hyperslice_domain, get_num_domains - -use distributed_state_mod, only : get_state, get_state_array +use types_mod, only : r4, r8, i8, MISSING_R4, MISSING_R8, vtablenamelength, MISSING_I, RAD2DEG -use ensemble_manager_mod, only : ensemble_type +use time_manager_mod, only : time_type, set_calendar_type, set_time, get_time, set_date, & + print_date, print_time + +use location_mod, only : location_type, get_close_type, & + loc_get_close_obs => get_close_obs, & + loc_get_close_state => get_close_state, & + is_vertical, set_location, set_location_missing, & + VERTISHEIGHT, query_location, get_location + +use utilities_mod, only : open_file, close_file, file_exist, logfileunit, register_module, & + error_handler, E_ERR, E_MSG, E_WARN, & + nmlfileunit, do_output, do_nml_file, do_nml_term, & + find_namelist_in_file, check_namelist_read, to_upper, & + find_enclosing_indices + +use obs_kind_mod, only : QTY_GEOMETRIC_HEIGHT -use netcdf_utilities_mod, only : nc_synchronize_file, nc_add_global_attribute, & - nc_add_global_creation_time, nc_begin_define_mode, & - nc_define_dimension, nc_end_define_mode, & - nc_put_variable,nc_add_attribute_to_variable, & - nc_define_real_variable, nc_open_file_readwrite, & - nc_check, nc_open_file_readonly, nc_get_dimension_size, & - nc_close_file, nc_get_variable, & - nc_get_dimension_size, nc_create_file, & - nc_define_double_variable, nc_define_double_scalar - +use netcdf_utilities_mod, only : nc_add_global_attribute, nc_synchronize_file, & + nc_add_global_creation_time, & + nc_begin_define_mode, nc_end_define_mode, & + nc_open_file_readonly, nc_get_dimension_size, nc_create_file, & + nc_close_file, nc_get_variable, nc_define_dimension, & + nc_define_real_variable, nc_open_file_readwrite, & + nc_add_attribute_to_variable, nc_put_variable, & + nc_define_unlimited_dimension, NF90_FILL_REAL -use dart_time_io_mod, only : write_model_time +use quad_utils_mod, only : quad_interp_handle, init_quad_interp, set_quad_coords, & + quad_lon_lat_locate, quad_lon_lat_evaluate, & + GRID_QUAD_FULLY_REGULAR, QUAD_LOCATED_CELL_CENTERS -use netcdf +use obs_kind_mod, only : get_index_for_quantity + +use state_structure_mod, only : add_domain, get_dart_vector_index, get_domain_size, & + get_model_variable_indices, get_varid_from_kind + +use distributed_state_mod, only : get_state + +use ensemble_manager_mod, only : ensemble_type + +! These routines are passed through from default_model_mod. +! To write model specific versions of these routines +! remove the routine from this use statement and add your code to +! this the file. +use default_model_mod, only : pert_model_copies, read_model_time, write_model_time, & + init_time => fail_init_time, & + init_conditions => fail_init_conditions, & + convert_vertical_obs, convert_vertical_state, adv_1step implicit none private -!DART mandatory public interfaces +! routines required by DART code - will be called from filter and other DART executables. +! TODO: Is nc_write_model_vars no longer mandatory? +! Tiegcm has it listed, but it's just a pass-through to-from default_model_mod +! which has a do-nothing version, and a note "currently unused". public :: get_model_size, & get_state_meta_data, & model_interpolate, & end_model, & static_init_model, & nc_write_model_atts, & - nc_write_model_vars, & get_close_obs, & get_close_state, & - shortest_time_between_assimilations, & + pert_model_copies, & convert_vertical_obs, & convert_vertical_state, & read_model_time, & - write_model_time - -!DART pass through interfaces -public :: adv_1step, & - init_conditions, & + adv_1step, & init_time, & - pert_model_copies + init_conditions, & + shortest_time_between_assimilations, & + write_model_time -! Interfaces needed by other programs, e.g. aether_to_dart and dart_to_aether -! block_file_name creates an Aether restart file name, -! which is useful for read_model_time calls, and others. public :: restart_files_to_netcdf, & netcdf_to_restart_files, & block_file_name -! version controlled file description for error handling, do not edit character(len=256), parameter :: source = 'aether_lon-lat/model_mod.f90' character(len=32 ), parameter :: revision = '' -character(len=128), parameter :: revdate = '' +character(len=32 ), parameter :: revdate = '' + +logical :: module_initialized = .false. +integer :: dom_id ! used to access the state structure +type(time_type) :: assimilation_time_step !------------------------------------------------------------------------------- -! namelist with default values - -! TODO: Define a derived type to handle the file types which need to be read andor written? -! PRobably not; variable_table probably handles it all. -! file_root {'neutrals','ions', 'time', f10_7? ...?) -! file_ext {'nc', 'nc', 'json', 'nc', ...) -! num_fields {nfields_neutral, nfields_ion, 2, ?, ...) -! character(len=8), dimension(2) :: file_root = /('neutrals','ions'/) - -! TODO; does it actually need filter_io_dir, or will the scripts make these programs -! run where the restart files are? -character(len=256) :: filter_io_dir = '.' -! TODO; remove GITM namelist vars -! TODO: if filter_io_filename is in global storage it doesn't need to be in (some?) arg lists. +! Default values for namelist +! TODO: replace model_nml:filter_io_filename with filter_io_root, +! so that namelist doesn't need to be changed for each member character(len=256) :: filter_io_filename = 'filter_input_0001.nc' -integer :: debug = 0 -logical :: estimate_f10_7 = .false. -character(len=256) :: f10_7_file_name = 'f10_7.nc' -real(r8) :: model_res = 5.0_r8 ! TODO VTEC calculations, but res shouldn't be hardwired - -! TODO: confirm that the units are days. -! Better to get the actual start day of Aether's calender. -integer :: aeth_ref_day = 2451545.0 ! cJULIAN2000 in Aether = day of date 2000/01/01. -character(len=32) :: calendar = 'Gregorian' -! Day 0 in this calendar is (+/1 a day) -4710/11/24 0 UTC -! But what we care about is the ref time for the times in the files, which is 1964-12-31 23:30 -! (from echo 2011032000 -1458345600s | ./advance_time). - -integer, dimension(:) :: aeth_ref_date(5) = (/1965,1,1,0,0/) ! y,mo,d,h,m (secs assumed 0) -type(time_type) :: aeth_ref_time -integer :: aeth_ref_ndays, aeth_ref_nsecs - -integer :: assimilation_period_seconds = 3600 - -! TODO: Aether restart files have 81 fields in them, -! mostly the 6 components of velocities for each ion. -! Aaron will provide files with a few more fields; e-, f10_7, ...? -integer, parameter :: MAX_NUM_VARIABLES = 100 -integer, parameter :: MAX_NUM_COLUMNS = 6 -character(len=NF90_MAX_NAME) :: variables(MAX_NUM_VARIABLES * MAX_NUM_COLUMNS) = ' ' - -namelist /model_nml/ filter_io_dir, & - variables, debug, estimate_f10_7, & - f10_7_file_name, calendar, assimilation_period_seconds, & - model_res - +integer :: time_step_days = 0 +integer :: time_step_seconds = 3600 +integer :: debug = 0 + +! KDR Should this be defined here, or does it come from netcdf_utilities_mod.f90? +! It's a public parameter from that module, which gets it from the netcdf module +! https://docs.unidata.ucar.edu/netcdf-fortran/current/f90-variables.html#f90-variables-introduction +! integer, parameter :: NF90_MAX_NAME = 256 +! This module uses vtablenamelength instead (which is shorter = less white space output +! to diagnostics). +integer, parameter :: MAX_STATE_VARIABLES = 100 +integer, parameter :: NUM_STATE_TABLE_COLUMNS = 6 +character(len=vtablenamelength) :: variables(NUM_STATE_TABLE_COLUMNS,MAX_STATE_VARIABLES) = ' ' + +namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables + !----------------------------------------------------------------------- ! aether_to_dart namelist parameters with default values. !----------------------------------------------------------------------- @@ -199,1777 +126,1545 @@ module model_mod character(len=256) :: aether_restart_dirname = 'none' ! TODO: the calling script will need to move this to a name with $member in it, ! or use filter_nml:input_state_file_list -character (len = 64) :: filter_io_root = 'filter_input' +character (len = vtablenamelength) :: filter_io_root = 'filter_input' -namelist /aether_to_dart_nml/ aether_restart_dirname, filter_io_root, variables +namelist /aether_to_dart_nml/ aether_restart_dirname, filter_io_root, variables, debug -!----------------------------------------------------------------------- ! dart_to_aether namelist parameters with default values. !----------------------------------------------------------------------- -namelist /dart_to_aether_nml/ aether_restart_dirname, filter_io_root, variables +namelist /dart_to_aether_nml/ aether_restart_dirname, filter_io_root, variables, debug !------------------------------------------------------------------------------- -! define model parameters for creating the state NetCDF file -! and handling interpolation, get_close, ... - -! nalt is number of midpoint levels -! TODO: Replace plevs with hlevs? Maybe not; pressure levels may be needed for interp. -! nilev -> an aether dimension size, that's not interface levels. -! Is not used by aether_to_dart or dart_to_aether (?). -integer :: nalt, nlon, nlat, nilev -real(r8),dimension(:), allocatable :: lons, lats, alts, plevs, ilevs -! HK are plevs, pilevs per ensemble member? -type(time_type) :: time_step - -type(quad_interp_handle) :: quad_interp - -! Codes for interpreting the columns of the variable_table -integer, parameter :: VT_VARNAMEINDX = 1 ! variable name -integer, parameter :: VT_KINDINDX = 2 ! DART quantity -integer, parameter :: VT_MINVALINDX = 3 ! minimum value if any -integer, parameter :: VT_MAXVALINDX = 4 ! maximum value if any -integer, parameter :: VT_ORIGININDX = 5 ! file of origin -integer, parameter :: VT_STATEINDX = 6 ! update (state) or not - -character(len=64) :: variable_table(MAX_NUM_VARIABLES, MAX_NUM_COLUMNS) - -type(time_type) :: state_time ! module-storage declaration of current model time - -integer(i8) :: model_size ! the state vector length -integer :: nfields, nfields_neutral, nfields_ion ! numbers of aether variables in DART state +! to be assigned in the assign_dimensions subroutine +real(r8), allocatable :: levs(:), lats(:), lons(:) +! Can't just change this to r4. +! I'll need to read the dims from filter_input_0001.nc into r4 temp array, +! then convert to these r8 vars. + + +integer :: nlev, nlat, nlon +real(r8) :: lon_start, lon_delta, lat_start, lat_delta, lat_end + +! write_model_time creates a time dimension with the UNLIMITED characteristic. +! The variable must have the time dimension, even if it's always only 1 (in restart files). +! TODO: using length * causes(?) a problem when calling nc_define_var_real_Nd +! with the list of dim_names in this order. nc_define also uses size * +! and apparently looks at the first one, sees that it's size 3, and assumes that for all. +! routine: nc_define_var_real_Nd +! message: "Temperature" inquire dimension id for dim "tim": +! errcode -46= NetCDF: Invalid dimension ID or name +character(len=4), parameter :: LEV_DIM_NAME = 'alt' +character(len=4), parameter :: LAT_DIM_NAME = 'lat' +character(len=4), parameter :: LON_DIM_NAME = 'lon' +character(len=4), parameter :: TIME_DIM_NAME = 'time' + +character(len=4), parameter :: LEV_VAR_NAME = 'alt' +character(len=4), parameter :: LAT_VAR_NAME = 'lat' +character(len=4), parameter :: LON_VAR_NAME = 'lon' +character(len=4), parameter :: TIME_VAR_NAME = 'time' -! lon and lat grid specs. -real(r8) :: bot_lon = MISSING_R8 -real(r8) :: top_lon = MISSING_R8 -real(r8) :: delta_lon = MISSING_R8 -real(r8) :: bot_lat = MISSING_R8 -real(r8) :: top_lat = MISSING_R8 -real(r8) :: delta_lat = MISSING_R8 -integer :: zero_lon_index = MISSING_I +! number of blocks along each dim +integer :: nblocks_lon=MISSING_I, nblocks_lat=MISSING_I, nblocks_lev=MISSING_I +! TODO: should nghost be read from the namelist? +integer :: nx_per_block, ny_per_block, nz_per_block +integer, parameter :: nghost = 2 ! number of ghost cells on all edges -! Obs locations are expected to be given in height [m] or level, -! and so vertical localization coordinate is *always* height. +!------------------------------------------------------------------------------- +integer :: aether_ref_day = 2451545.0 ! cJULIAN2000 in Aether = day of date 2000/01/01. +character(len=32) :: calendar = 'GREGORIAN' +! Day 0 in this calendar is (+/1 a day) -4710/11/24 0 UTC +! But what we care about is the ref time for the times in the files, which is 1965-1-1 00:00 -character(len=512) :: string1, string2, string3 -logical, save :: module_initialized = .false. +integer, dimension(:) :: aether_ref_date(5) = (/1965,1,1,0,0/) ! y,mo,d,h,m (secs assumed 0) +type(time_type) :: aether_ref_time +integer :: aether_ref_ndays, aether_ref_nsecs -!=============================================================================== -! Define Aether whole-grid and block grid dimension variables. +!------------------------------------------------------------------------------- +! to be assigned in the verify_variables subroutine +integer :: nvar, nvar_neutral, nvar_ion -character(len=*), parameter :: LON_DIM_NAME = 'lon' -character(len=*), parameter :: LAT_DIM_NAME = 'lat' -character(len=*), parameter :: ALT_DIM_NAME = 'alt' +character(len=vtablenamelength) :: var_names(MAX_STATE_VARIABLES) +real(r8) :: var_ranges(MAX_STATE_VARIABLES,2) +logical :: var_update(MAX_STATE_VARIABLES) +integer :: var_qtys(MAX_STATE_VARIABLES) -character(len=*), parameter :: LON_VAR_NAME = 'lon' -character(len=*), parameter :: LAT_VAR_NAME = 'lat' -character(len=*), parameter :: ALT_VAR_NAME = 'alt' +type(quad_interp_handle) :: quad_interp -! {nxPerBlock,nyPerBlock} are the number of non-halo {lons,lats} PER block -! the number of blocks comes from UAM.in -! nzPerBlock is the number of altitudes, which does not depend on block -! nGhost is the halo region width in the block(subdomain) files. -! TODO: change nGhost to nhalo? -! TODO: n[xyz]PerBlock should probably come from a namelist (aether_to_dart.nml; -! can that be used for dart_to_aether?) +! Codes for interpreting the columns of the variables table +! KDR; Move this closer to definition of variables( , ) +! so that it's clearer how many columns there need to be. +integer, parameter :: VT_VARNAMEINDX = 1 ! ... variable name +integer, parameter :: VT_KINDINDX = 2 ! ... DART kind +integer, parameter :: VT_MINVALINDX = 3 ! ... minimum value if any +integer, parameter :: VT_MAXVALINDX = 4 ! ... maximum value if any +integer, parameter :: VT_ORIGININDX = 5 ! file of origin +integer, parameter :: VT_STATEINDX = 6 ! ... update (state) or not -integer :: nxPerBlock, nyPerBlock, nzPerBlock -integer, parameter :: nGhost = 2 ! number of ghost cells on all edges +integer, parameter :: GENERAL_ERROR_CODE = 99 +integer, parameter :: INVALID_VERT_COORD_ERROR_CODE = 15 +integer, parameter :: INVALID_LATLON_VAL_ERROR_CODE = 16 +integer, parameter :: INVALID_ALTITUDE_VAL_ERROR_CODE = 17 +integer, parameter :: UNKNOWN_OBS_QTY_ERROR_CODE = 20 -! "... keep in mind that if the model resolution is 5 deg latitude, -! the model will actually go from -87.5 to 87.5 latitude -! (even though you specify -90 to 90 in the UAM.in file), -! since the latitudes/longitudes are at cell centers, -! while the edges are at the boundaries." -- Aaron Ridley +type(time_type) :: state_time ! module-storage declaration of current model time -! number of blocks along each dim -integer :: nBlocksLon=MISSING_I, nBlocksLat=MISSING_I, nBlocksAlt=MISSING_I -real(r8) :: LatStart=MISSING_R8, LatEnd=MISSING_R8, LonStart=MISSING_R8 +character(len=512) :: error_string_1, error_string_2 contains -!=============================================================================== -! Routines in this section (down to "private") are public. -!=============================================================================== +!------------------------------------------------------------------ +! +! Called to do one time initialization of the model. As examples, +! might define information about the model size or model timestep. +! In models that require pre-computed static data, for instance +! spherical harmonic weights, these would also be computed here. subroutine static_init_model() -character(len=*), parameter :: routine = 'static_init_model' +integer :: iunit, io -character(len=128) :: aether_filename +module_initialized = .true. -if (module_initialized) return ! only need to do this once ! Print module information to log file and stdout. -call register_module(source, revision, revdate) +call register_module(source) -module_initialized = .true. +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") -! Read the namelist entry for model_mod from input.nml -call read_model_namelist() +! 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) -if (do_output()) then - write( * ,*)'static_init_model: debug level is ',debug - write(logfileunit,*)'static_init_model: debug level is ',debug -endif +call set_calendar_type(calendar) -!--------------------------------------------------------------- -! get whole grid dimensions and values +! Debug global att creation time +! This filter_io_filename comes from the namelist (filter_input_0001.nc) +! Somehow filter is creating 'filter_output_0001.nc' when it dies. +call assign_dimensions(filter_io_filename, levs, lats, lons, nlev, nlat, nlon) -write(string1,'(3A)') "Now reading filter_io file ",trim(filter_io_filename),& - " for grid information" -call error_handler(E_MSG,routine,string1,source,revision,revdate) +! Dimension start and deltas needed for set_quad_coords +lon_start = lons(1) +lon_delta = lons(2)-lons(1) +lat_start = lats(1) +lat_delta = lats(2)-lats(1) -! TODO; do these need to be deallocated somewhere? -allocate(lons(nlon)) -allocate(lats(nlat)) -allocate(alts(nalt)) +call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) -!--------------------------------------------------------------- -! get grid dimensions and values -call get_grid_from_netcdf(lons, lats, alts) +! This time is both the minimum time you can ask the model to advance +! (for models that can be advanced by filter) and it sets the assimilation +! window. All observations within +/- 1/2 this interval from the current +! model time will be assimilated. If this is not settable at runtime +! feel free to hardcode it and remove from the namelist. +assimilation_time_step = set_time(time_step_seconds, & + time_step_days) -!--------------------------------------------------------------- -! mass points at cell centers -call init_quad_interp(GRID_QUAD_IRREG_SPACED_REGULAR, nlon, nlat, & +! Define which variables are in the model state +! This is using add_domain_from_file (arg list matches) +dom_id = add_domain(filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) + +call init_quad_interp(GRID_QUAD_FULLY_REGULAR, nlon, nlat, & QUAD_LOCATED_CELL_CENTERS, & - global=.false., spans_lon_zero=.false., pole_wrap=.false., & + global=.true., spans_lon_zero=.true., pole_wrap=.true., & interp_handle=quad_interp) -call set_quad_coords(quad_interp, lons, lats) - -if ( debug > 0 ) then - write(string1,'("grid: nlon, nlat, nalt =",3(1x,i5))') nlon, nlat, nalt - call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif - -if ( estimate_f10_7 ) then - call error_handler(E_MSG, 'f10_7 part of DART state', source) -endif - -! error-check, convert namelist input to variable_table, and build the -! state structure -call make_variable_table() - -call set_calendar_type(calendar) - -! Read and convert the time (seconds from the aether_ref_date) to a dart time. -aether_filename = block_file_name(variable_table(1,VT_ORIGININDX), 0, 0) -state_time = read_model_time(trim(aether_filename)) - -! Initialized in namelist. -time_step = set_time(assimilation_period_seconds, 0) +call set_quad_coords(quad_interp, lon_start, lon_delta, lat_start, lat_delta) end subroutine static_init_model -!================================================================== - -!> Create a filename from input file characteristics: -! filetype, member number, block number. -! filetype = {'grid','neutrals','ions', [...?]}. -! The first part of the name of the aether file to read. -! memnum or blocknum < 0 means don't include that part of the name. - -function block_file_name(filetype, memnum, blocknum) - -character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} -! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? -! This code can handle it; a longer filetype passed in, and no member -! ? output files? -integer, intent(in) :: blocknum -integer, intent(in) :: memnum -character(len=128) :: block_file_name -character(len=*), parameter :: routine = 'block_file_name' - -block_file_name = trim(filetype) -if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum -if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum -block_file_name = trim(block_file_name)//'.nc' -if ( debug > 0 ) then - write(string1,'("filename, memnum, blocknum = ",A,2(1x,i5))') & - trim(block_file_name), memnum, blocknum - call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif - -end function block_file_name - -!================================================================== -!> Converts Aether restart files to a netCDF file -!> -!> This routine needs: -!> -!> 1. A base dirname for the restart files (restart_dirname). -!> they will have the format 'dirname/{neutrals,ions}_mMMMM_gBBBB.rst' -!> where BBBB is the block number, MMMM is the member number, -!> and they have leading 0s. Blocks start in the -!> southwest corner of the lat/lon grid and go east first, -!> then to the west end of the next row north and end in the northeast corner. -!> -!> In the process, the routine will find: -!> -!> 1. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. -!> (nBlocksLon, nBlocksLat, 1) -!> -!> 2. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) -!> -!> 3. The number of lon/lats in a single grid block (nxPerBlock, -!> nyPerBlock, nzPerBlock) -!> -!> 4. The number of neutral species (and probably a mapping between -!> the species number and the variable name) (nSpeciesTotal, nSpecies) -!> -!> 5. The number of ion species (ditto - numbers <-> names) (nIons) -!> -!> In addition to reading in the state data, it fills Longitude, Latitude, and Altitude arrays. -!> This grid is orthogonal and rectangular but can have irregular spacing along -!> any of the three dimensions. - -subroutine restart_files_to_netcdf(member) - -! TODO: Does restart_files_to_netcdf need restart_dir? -integer, intent(in) :: member +!------------------------------------------------------------------ +! Returns the number of items in the state vector as an integer. -integer :: ncid +function get_model_size() -character(len=*), parameter :: routine = 'restart_files_to_netcdf' +integer(i8) :: get_model_size -if (module_initialized ) then - write(string1,*)'The aether static_init_model was already initialized but ',trim(routine),& - ' uses a separate initialization procedure' - call error_handler(E_ERR,routine,string1,source,revision,revdate) -end if +if ( .not. module_initialized ) call static_init_model -call static_init_blocks("aether_to_dart_nml") +get_model_size = get_domain_size(dom_id) -write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member+1,'.nc' -ncid = nc_create_file(filter_io_filename) +end function get_model_size -call error_handler(E_MSG, '', '') -write(string1,*) 'converting Aether restart files in directory ', & - "'"//trim(aether_restart_dirname)//"'" -write(string2,*) ' to the NetCDF file ', "'"//trim(filter_io_filename)//"'" -call error_handler(E_MSG, routine, string1, text2=string2) -call error_handler(E_MSG, '', '') +!----------------------------------------------------------------------- -! Enters and exits define mode; -call nc_write_model_atts(ncid, 0) +subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs, istatus) + + type(ensemble_type), intent(in) :: state_handle + integer, intent(in) :: ens_size + type(location_type), intent(in) :: location + integer, intent(in) :: qty + real(r8), intent(out) :: expected_obs(ens_size) + integer, intent(out) :: istatus(ens_size) + + ! Local storage + + character(len=*), parameter :: routine = 'model_interpolate' + + real(r8) :: loc_array(3), llon, llat, lvert, lon_fract, lat_fract + integer :: four_lons(4), four_lats(4) + integer :: status1, which_vert, varid + real(r8) :: quad_vals(4, ens_size) + + if ( .not. module_initialized ) call static_init_model + + ! Assume failure. Set return val to missing, then the code can + ! just set istatus to something indicating why it failed, and return. + ! If the interpolation is good, expected_obs will be set to the + ! good values, and the last line here sets istatus to 0. + ! make any error codes set here be in the 10s + + expected_obs = MISSING_R8 ! the DART bad value flag + istatus = GENERAL_ERROR_CODE ! unknown error + + ! Get the individual locations values + + loc_array = get_location(location) + llon = loc_array(1) + llat = loc_array(2) + lvert = loc_array(3) + which_vert = nint(query_location(location)) + + IF (debug > 85) then + write(error_string_1,*) 'requesting interpolation at ', llon, llat, lvert + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + end if + + ! Only height and level for vertical location type is supported at this point + if (.not. is_vertical(location, "HEIGHT") .and. .not. is_vertical(location, "LEVEL")) THEN + istatus = INVALID_VERT_COORD_ERROR_CODE + return + endif + + if (qty == QTY_GEOMETRIC_HEIGHT .and. is_vertical(location, "LEVEL")) then + if (nint(lvert) < 1 .or. nint(lvert) > size(levs,1)) then + expected_obs = MISSING_R8 + istatus = 1 + else + expected_obs = levs(nint(lvert)) + istatus = 0 + endif + return ! Early Return + endif + + ! do we know how to interpolate this quantity? + call ok_to_interpolate(qty, varid, status1) + + if (status1 /= 0) then + if(debug > 12) then + write(error_string_1,*) 'Did not find observation quantity ', qty, ' in the state vector' + call error_handler(E_WARN,routine,error_string_1,source,revision,revdate) + endif + istatus(:) = status1 ! this quantity not in the state vector + return + 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(quad_interp, llon, llat, & + four_lons, four_lats, lon_fract, lat_fract, status1) + if (status1 /= 0) then + istatus(:) = INVALID_LATLON_VAL_ERROR_CODE ! cannot locate enclosing horizontal quad + return + endif + + call get_quad_vals(state_handle, ens_size, varid, four_lons, four_lats, & + loc_array, which_vert, quad_vals, istatus) + if (any(istatus /= 0)) return + + ! do the horizontal interpolation for each ensemble member + call quad_lon_lat_evaluate(quad_interp, lon_fract, lat_fract, ens_size, & + quad_vals, expected_obs, istatus) + + ! All good. + istatus(:) = 0 + +end subroutine model_interpolate + +!------------------------------------------------------------------ +! Returns the smallest increment in time that the model is capable +! of advancing the state in a given implementation, or the shortest +! time you want the model to advance between assimilations. -call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) +function shortest_time_between_assimilations() -! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts -! but maybe it shouldn't be. -! call add_nc_dimvars(ncid) +type(time_type) :: shortest_time_between_assimilations -call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) +if ( .not. module_initialized ) call static_init_model -! TODO: this needs to be updated to write to which file? -! call write_model_time(ncid, state_time) +shortest_time_between_assimilations = assimilation_time_step -call nc_close_file(ncid) +end function shortest_time_between_assimilations -call error_handler(E_MSG, '', '') -write(string1,*) 'Successfully converted the Aether restart files to ', & - "'"//trim(filter_io_filename)//"'" -call error_handler(E_MSG, routine, string1) -call error_handler(E_MSG, '', '') -end subroutine restart_files_to_netcdf +!------------------------------------------------------------------ +! Given an integer index into the state vector, returns the +! associated location and optionally the physical quantity. -!================================================================= -! Writes the current time and state variables from a dart state -! vector (1d array) into a gitm netcdf restart file. +subroutine get_state_meta_data(index_in, location, qty) -subroutine netcdf_to_restart_files(member) +integer(i8), intent(in) :: index_in +type(location_type), intent(out) :: location +integer, intent(out), optional :: qty -integer, intent(in) :: member +character(len=*), parameter :: routine = 'get_state_meta_data' -integer :: ncid -character(len=*), parameter :: routine = 'netcdf_to_restart_files:' +! Local variables -! write out the state vector data. -! when this routine returns all the data has been written. +integer :: lat_index, lon_index, lev_index +integer :: my_var_id, my_qty -if (module_initialized ) then - write(string1,*)'The gitm mod was already initialized but ',trim(routine),& - ' uses a separate initialization procedure' - call error_handler(E_ERR,routine,string1,source,revision,revdate) -end if +if ( .not. module_initialized ) call static_init_model -call static_init_blocks("dart_to_aether_nml") +! KDR restart data is ordered (lev,lat,lon) +! call get_model_variable_indices(index_in, lon_index, lat_index, lev_index, & +call get_model_variable_indices(index_in, lev_index, lat_index, lon_index, & + var_id=my_var_id, kind_index=my_qty) -write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member+1,'.nc' +! should be set to the actual location using set_location() +location = set_location(lons(lon_index), lats(lat_index), levs(lev_index), VERTISHEIGHT) -call error_handler(E_MSG,routine,'','',revision,revdate) -write(string1,*) 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" -write(string2,*) 'into Aether restart files in directory ', "'"//trim(aether_restart_dirname)//"'" -call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2) +! should be set to the physical quantity, e.g. QTY_TEMPERATURE +if (present(qty)) qty = my_qty -ncid = nc_open_file_readonly(filter_io_filename, routine) +end subroutine get_state_meta_data -call filter_to_restarts(ncid, member) -!---------------------------------------------------------------------- -! Log what we think we're doing, and exit. -!---------------------------------------------------------------------- -call error_handler(E_MSG,routine,'','',revision,revdate) -write(string1,*) 'Successfully converted to the Aether restart files in directory' -write(string2,*) "'"//trim(aether_restart_dirname)//"'" -call error_handler(E_MSG,routine,string1,source,revision,revdate,text2=string2) +!------------------------------------------------------------------ +! Any model specific distance calcualtion can be done here -call nc_close_file(ncid) +subroutine get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & + num_close, close_ind, dist, ens_handle) -end subroutine netcdf_to_restart_files +type(get_close_type), intent(in) :: gc ! handle to a get_close structure +integer, intent(in) :: base_type ! observation TYPE +type(location_type), intent(inout) :: base_loc ! location of interest +type(location_type), intent(inout) :: locs(:) ! obs locations +integer, intent(in) :: loc_qtys(:) ! QTYS for obs +integer, intent(in) :: loc_types(:) ! TYPES for obs +integer, intent(out) :: num_close ! how many are close +integer, intent(out) :: close_ind(:) ! incidies into the locs array +real(r8), optional, intent(out) :: dist(:) ! distances in radians +type(ensemble_type), optional, intent(in) :: ens_handle -!================================================================= +character(len=*), parameter :: routine = 'get_close_obs' -function get_model_size() -! Returns the size of the model as an integer. +call loc_get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & + num_close, close_ind, dist, ens_handle) -integer(i8) :: get_model_size +end subroutine get_close_obs -if ( .not. module_initialized ) call static_init_model +!------------------------------------------------------------------ +! Any model specific distance calcualtion can be done here -get_model_size = model_size +subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & + num_close, close_ind, dist, ens_handle) -end function get_model_size +type(get_close_type), intent(in) :: gc ! handle to a get_close structure +type(location_type), intent(inout) :: base_loc ! location of interest +integer, intent(in) :: base_type ! observation TYPE +type(location_type), intent(inout) :: locs(:) ! state locations +integer, intent(in) :: loc_qtys(:) ! QTYs for state +integer(i8), intent(in) :: loc_indx(:) ! indices into DART state vector +integer, intent(out) :: num_close ! how many are close +integer, intent(out) :: close_ind(:) ! indices into the locs array +real(r8), optional, intent(out) :: dist(:) ! distances in radians +type(ensemble_type), optional, intent(in) :: ens_handle -!================================================================== -! TODO; will be provided by Ben's model_mod. -! - subroutine model_interpolate(state_handle, ens_size, location, iqty, obs_val, istatus) - ! Given a location, and a model state variable qty, - ! interpolates the state variable field to that location. - ! obs_val is the interpolated value for each ensemble member - ! istatus is the success (0) or failure of the interpolation - - type(ensemble_type), intent(in) :: state_handle - integer, intent(in) :: ens_size - type(location_type), intent(in) :: location - integer, intent(in) :: iqty - real(r8), intent(out) :: obs_val(ens_size) !< array of interpolated values - integer, intent(out) :: istatus(ens_size) - - integer :: which_vert - integer :: lat_below, lat_above, lon_below, lon_above ! these are indices - real(r8) :: lon_fract, lat_fract - real(r8) :: lon, lat, lon_lat_lev(3) - real(r8), dimension(ens_size) :: val11, val12, val21, val22 - real(r8) :: height - integer :: level, bogus_level - integer :: dom_id, var_id -! -! if ( .not. module_initialized ) call static_init_model -! -! ! Default for failure return -! istatus(:) = 1 -! obs_val(:) = MISSING_R8 -! -! ! Failure codes -! ! 11 QTY_GEOPOTENTIAL_HEIGHT is unsupported -! ! 22 unsupported veritcal coordinate -! ! 33 level given < or > model levels -! ! 44 quantity not part of the state -! ! 55 outside state (can not extrapolate above or below) -! ! 66 unknown vertical stagger -! -! ! GITM uses a vtec routine in obs_def_upper_atm_mod:get_expected_gnd_gps_vtec() -! ! TIEGCM has its own vtec routine, so we should use it. This next block ensures that. -! ! The get_expected_gnd_gps_vtec() tries to interpolate QTY_GEOPOTENTIAL_HEIGHT -! ! when it does, this will kill it. -! -! if ( iqty == QTY_GEOPOTENTIAL_HEIGHT ) then -! istatus(:) = 11 -! write(string1,*)'QTY_GEOPOTENTIAL_HEIGHT currently unsupported' -! call error_handler(E_ERR,'model_interpolate',string1,source, revision, revdate) -! endif -! -! -! ! Get the position -! lon_lat_lev = get_location(location) -! lon = lon_lat_lev(1) ! degree -! lat = lon_lat_lev(2) ! degree -! height = lon_lat_lev(3) ! level (int) or height (real) -! level = int(lon_lat_lev(3)) -! -! -! which_vert = nint(query_location(location)) -! -! call compute_bracketing_lat_indices(lat, lat_below, lat_above, lat_fract) -! call compute_bracketing_lon_indices(lon, lon_below, lon_above, lon_fract) -! -! ! Pressure is not part of the state vector -! ! pressure is static data on plevs/pilevs -! if ( iqty == QTY_PRESSURE) then -! if (which_vert == VERTISLEVEL) then -! ! @todo from Lanai code: -! ! Some variables need plevs, some need pilevs -! ! We only need the height (aka level) -! ! the obs_def_upper_atm_mod.f90:get_expected_O_N2_ratio routines queries -! ! for the pressure at the model levels - EXACTLY - so ... -! ! FIXME ... at present ... the only time model_interpolate -! ! gets called with QTY_PRESSURE is to calculate density, which -! ! requires other variables that only live on the midpoints. -! ! I cannot figure out how to generically decide when to -! ! use plevs vs. pilevs -! -! ! Check to make sure vertical level is possible. -! if ((level < 1) .or. (level > nalt)) then -! istatus(:) = 33 -! return -! else -! obs_val(:) = plevs(level) -! istatus(:) = 0 -! endif -! elseif (which_vert == VERTISHEIGHT) then -! -! ! @todo from Lanai code: -! ! FIXME ... is it possible to try to get a pressure with which_vert == undefined -! ! At present, vert_interp will simply fail because height is a negative number. -! ! @todo HK what are you supposed to do for pressure with VERTISUNDEF? level 1? -! -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) -! if (any(istatus /= 0)) return ! bail at the first failure -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) -! if (any(istatus /= 0)) return -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) -! if (any(istatus /= 0)) return -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! else -! -! write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' -! call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) -! -! endif ! which vert -! -! return -! -! endif ! end of QTY_PRESSURE -! -! -! if ( iqty == QTY_VERTICAL_TEC ) then ! extrapolate vtec -! -! call extrapolate_vtec(state_handle, ens_size, lon_below, lat_below, val11) -! call extrapolate_vtec(state_handle, ens_size, lon_below, lat_above, val11) -! call extrapolate_vtec(state_handle, ens_size, lon_above, lat_below, val11) -! call extrapolate_vtec(state_handle, ens_size, lon_above, lat_above, val11) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! istatus(:) = 0 -! -! return -! endif -! -! ! check if qty is in the state vector -! call find_qty_in_state(iqty, dom_id, var_id) -! if (dom_id < 0 ) then -! istatus(:) = 44 -! return -! endif -! -! if( which_vert == VERTISHEIGHT ) then -! -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_below, height, iqty, val11, istatus) -! if (any(istatus /= 0)) return ! bail at the first failure -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_below, lat_above, height, iqty, val12, istatus) -! if (any(istatus /= 0)) return -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_below, height, iqty, val21, istatus) -! if (any(istatus /= 0)) return -! call vert_interp(state_handle, ens_size, dom_id, var_id, lon_above, lat_above, height, iqty, val22, istatus) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! istatus = 0 -! elseif( which_vert == VERTISLEVEL) then -! ! Check to make sure vertical level is possible. -! if ((level < 1) .or. (level > nilev)) then -! istatus(:) = 33 -! return -! endif -! -! ! one use of model_interpolate is to allow other modules/routines -! ! the ability to 'count' the model levels. To do this, create observations -! ! with locations on model levels and 'interpolate' for QTY_GEOMETRIC_HEIGHT. -! ! When the interpolation fails, you've gone one level too far. -! ! HK why does it have to be QTY_GEOMETRIC_HEIGHT? -! -! val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, level, domain_id(dom_id), var_id ), state_handle) -! val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, level, domain_id(dom_id), var_id ), state_handle) -! val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, level, domain_id(dom_id), var_id ), state_handle) -! val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, level, domain_id(dom_id), var_id ), state_handle) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! istatus = 0 -! -! elseif( which_vert == VERTISUNDEF) then -! bogus_level = 1 !HK what should this be? Do only 2D fields have VERTISUNDEF? -! val11(:) = get_state(get_dart_vector_index(lon_below, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) -! val12(:) = get_state(get_dart_vector_index(lon_below, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) -! val21(:) = get_state(get_dart_vector_index(lon_above, lat_below, bogus_level, domain_id(dom_id), var_id), state_handle) -! val22(:) = get_state(get_dart_vector_index(lon_above, lat_above, bogus_level, domain_id(dom_id), var_id), state_handle) -! obs_val(:) = interpolate(ens_size, lon_fract, lat_fract, val11, val12, val21, val22) -! istatus(:) = 0 -! -! else -! -! write(string1,*) 'vertical coordinate type:',which_vert,' cannot be handled' -! call error_handler(E_ERR,'model_interpolate',string1,source,revision,revdate) -! -! endif -! - end subroutine model_interpolate +character(len=*), parameter :: routine = 'get_close_state' -!------------------------------------------------------------------------------- -function shortest_time_between_assimilations() -type(time_type) :: shortest_time_between_assimilations -shortest_time_between_assimilations = time_step +call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & + num_close, close_ind, dist, ens_handle) -end function shortest_time_between_assimilations +end subroutine get_close_state -!================================================================== -! - subroutine get_state_meta_data(index_in, location, var_qty) - ! Given an integer index into the state vector, returns the - ! associated location and optionally the variable quantity. - - integer(i8), intent(in) :: index_in - type(location_type), intent(out) :: location - integer, optional, intent(out) :: var_qty - - integer :: lon_index, lat_index, lev_index - integer :: local_qty, var_id, dom_id - integer :: seconds, days ! for f10.7 location - real(r8) :: longitude ! for f10.7 location - character(len=NF90_MAX_NAME) :: dim_name - -! if ( .not. module_initialized ) call static_init_model -! -! call get_model_variable_indices(index_in, lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id, kind_index=local_qty) -! -! if(present(var_qty)) var_qty = local_qty -! -! if (get_variable_name(dom_id, var_id) == 'f10_7') then -! ! f10_7 is most accurately located at local noon at equator. -! ! 360.0 degrees in 86400 seconds, 43200 secs == 12:00 UTC == longitude 0.0 -! -! call get_time(state_time, seconds, days) -! longitude = 360.0_r8 * real(seconds,r8) / 86400.0_r8 - 180.0_r8 -! if (longitude < 0.0_r8) longitude = longitude + 360.0_r8 -! location = set_location(longitude, 0.0_r8, 400000.0_r8, VERTISUNDEF) -! return -! end if -! -! ! search for either ilev or lev -! dim_name = ilev_or_lev(dom_id, var_id) -! -! select case (trim(dim_name)) -! case ('ilev') -! location = set_location(lons(lon_index), lats(lat_index), ilevs(lev_index), VERTISLEVEL) -! case (ALT_DIM_NAME) -! location = set_location(lons(lon_index), lats(lat_index), alts(lev_index), VERTISLEVEL) -! case default -! call error_handler(E_ERR, 'get_state_meta_data', 'expecting ilev or ilat dimension') -! ! HK @todo 2D variables. -! end select -! - end subroutine get_state_meta_data - -!================================================================== +!------------------------------------------------------------------ +! Does any shutdown and clean-up needed for model. Can be a NULL +! INTERFACE if the model has no need to clean up storage, etc. subroutine end_model() -! Does any shutdown and clean-up needed for model. end subroutine end_model -!================================================================== - -! Writes the model-specific attributes to a netCDF file. -subroutine nc_write_model_atts( ncid, dom_id) +!------------------------------------------------------------------ +! write any additional attributes to the output and diagnostic files -integer, intent(in) :: ncid ! netCDF file identifier -integer, intent(in) :: dom_id +subroutine nc_write_model_atts(ncid, domain_id) -real(r8), allocatable :: temp_lons(:) +integer, intent(in) :: ncid ! netCDF file identifier +integer, intent(in) :: domain_id character(len=*), parameter :: routine = 'nc_write_model_atts' if ( .not. module_initialized ) call static_init_model -! Write Global Attributes +! It is already in define mode from nc_create_file. +! OR NOT, if called by create_and_open_state_output +call nc_begin_define_mode(ncid) +! Debug global att creation time; This requires being in define mode. +! nc_write_model_atts is called by create_and_open_state_output, +! which calls nf90_enddef before it. call nc_add_global_creation_time(ncid, routine) call nc_add_global_attribute(ncid, "model_source", source, routine) -call nc_add_global_attribute(ncid, "model", "Aether", routine) - +call nc_add_global_attribute(ncid, "model", "aether", routine) ! define grid dimensions -call nc_define_dimension(ncid, LON_DIM_NAME, nlon, routine) -call nc_define_dimension(ncid, LAT_DIM_NAME, nlat, routine) -call nc_define_dimension(ncid, ALT_DIM_NAME, nalt, routine) -call nc_define_dimension(ncid, 'ilev', nilev, routine) + + + +call nc_define_dimension(ncid, trim(LEV_DIM_NAME), nlev, routine) +call nc_define_dimension(ncid, trim(LAT_DIM_NAME), nlat, routine) +call nc_define_dimension(ncid, trim(LON_DIM_NAME), nlon, routine) +! TODO: UNLIMITED (time ) should be the last dimension. Document it? +call nc_define_unlimited_dimension(ncid, trim(TIME_DIM_NAME), routine) ! define grid variables -! longitude -call nc_define_real_variable( ncid, LON_DIM_NAME, (/ LON_DIM_NAME /), routine) -call nc_add_attribute_to_variable(ncid, LON_DIM_NAME, 'long_name', 'geographic longitude (-west, +east)', routine) -call nc_add_attribute_to_variable(ncid, LON_DIM_NAME, 'units', 'degrees_east', routine) + +! z +call nc_define_real_variable( ncid, trim(LEV_VAR_NAME), (/ trim(LEV_DIM_NAME) /), routine) +call nc_add_attribute_to_variable(ncid, trim(LEV_VAR_NAME), 'units', 'm', routine) +call nc_add_attribute_to_variable(ncid, trim(LEV_VAR_NAME), 'long_name', 'height above mean sea level', routine) ! latitude -call nc_define_real_variable( ncid, LAT_DIM_NAME, (/ LAT_DIM_NAME /), routine) -call nc_add_attribute_to_variable(ncid, LAT_DIM_NAME, 'long_name', 'geographic latitude (-south, +north)', routine) -call nc_add_attribute_to_variable(ncid, LAT_DIM_NAME, 'units', 'degrees_north', routine) - -! alts -call nc_define_real_variable( ncid, ALT_DIM_NAME, (/ ALT_DIM_NAME /), routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'long_name', 'midpoint altitudes', routine) -! DONE: vert coord is altitude, not ... -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'short name', 'altitude', routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'positive', 'up', routine) -call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'standard_name', 'unknown', routine) -! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula_terms', 'p0: p0 lev: lev', routine) -! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-lev(k))', routine) - - -! ilevs -! call nc_define_real_variable( ncid, 'ilev', (/ 'ilev' /), routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'long_name', 'interface levels', routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'short name', 'ln(p0/p)', routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'positive', 'up', routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'standard_name', 'atmosphere_ln_pressure_coordinate', routine) -! call nc_add_attribute_to_variable(ncid, 'ilev', 'formula_terms', 'p0: p0 lev: ilev', routine) -! ! TODO: Is there an interface alt? -! call nc_add_attribute_to_variable(ncid, ALT_DIM_NAME, 'formula', 'p(k) = p0 * exp(-ilev(k))', routine) - - -call nc_end_define_mode(ncid, routine) +call nc_define_real_variable( ncid, trim(LAT_VAR_NAME), (/ trim(LAT_DIM_NAME) /), routine) +call nc_add_attribute_to_variable(ncid, trim(LAT_VAR_NAME), 'units', 'degrees_north', routine) +call nc_add_attribute_to_variable(ncid, trim(LAT_VAR_NAME), 'long_name', 'latitude', routine) + +! longitude +call nc_define_real_variable( ncid, trim(LON_VAR_NAME), (/ trim(LON_VAR_NAME) /), routine) +call nc_add_attribute_to_variable(ncid, trim(LON_VAR_NAME), 'units', 'degrees_east', routine) +call nc_add_attribute_to_variable(ncid, trim(LON_VAR_NAME), 'long_name', 'longitude', routine) + +! Dimension 'time' will no longer be created by write_model_time, +! since it's explicitly done by nc_define_unlimited_dimension. +! longitude +call nc_define_real_variable( ncid, trim(TIME_VAR_NAME), (/ trim(TIME_VAR_NAME) /), routine) +call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'calendar', 'gregorian', routine) +call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'units', 'days since 1601-01-01 00:00:00', routine) +call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'long_name', 'gregorian_days', routine) -!------------------------------------------------------------------------------- -! Write variables -!------------------------------------------------------------------------------- + +call nc_end_define_mode(ncid) ! TODO: Should nc_write_model_atts write dimension contents, not just atts? ! Gitm had a separate routine for filling the dimensions: ! - - - - - - - - - - - ! subroutine add_nc_dimvars(ncid) -! -! integer, intent(in) :: ncid -! -! !---------------------------------------------------------------------------- -! ! Fill the coordinate variables -! !---------------------------------------------------------------------------- -! -! call nc_put_variable(ncid, LON_VAR_NAME, lons) -! call nc_put_variable(ncid, LAT_VAR_NAME, lats) -! call nc_put_variable(ncid, ALT_VAR_NAME, alts) -! ! what about WL? -! -! !if (has_gitm_namelist) then -! ! call file_to_text('gitm_vars.nml', textblock) -! ! call nc_put_variable(ncid, 'gitm_in', textblock) -! ! deallocate(textblock) -! !endif -! -! !------------------------------------------------------------------------------- -! ! Flush the buffer and leave netCDF file open -! !------------------------------------------------------------------------------- -! call nc_synchronize_file(ncid) -! -! end subroutine add_nc_dimvars -! - - - - - - - - - - - +call nc_put_variable(ncid, trim(LEV_VAR_NAME), levs, routine) +call nc_put_variable(ncid, trim(LAT_VAR_NAME), lats, routine) +call nc_put_variable(ncid, trim(LON_VAR_NAME), lons, routine) +print*,routine,': passed putting the dimensions' +! Flush the buffer and leave netCDF file open +call nc_synchronize_file(ncid) -! Fill in the coordinate variables +end subroutine nc_write_model_atts -! longitude - Aether uses values +/- pi, but lons has been converted already. -! DART uses values [0,360] -allocate(temp_lons(nlon)) -temp_lons = lons -where (temp_lons < 0.0_r8) temp_lons = temp_lons + 360.0_r8 -! where (temp_lons >= 180.0_r8) temp_lons = temp_lons - 360.0_r8 -call nc_put_variable(ncid, LON_VAR_NAME, temp_lons, routine) -call nc_put_variable(ncid, LAT_VAR_NAME, lats, routine) -call nc_put_variable(ncid, ALT_VAR_NAME, alts, routine) -! call nc_put_variable(ncid, 'ilev', ilevs, routine) -deallocate(temp_lons) +!------------------------------------------------------------------ +! Read dimension information from the template file and use +! it to assign values to variables. -! flush any pending i/o to disk -call nc_synchronize_file(ncid, routine) +subroutine assign_dimensions(filter_io_filename, levs, lats, lons, nlev, nlat, nlon) -end subroutine nc_write_model_atts -!================================================================== + character(len=*), intent(in) :: filter_io_filename + real(r8), allocatable, intent(out) :: levs(:), lats(:), lons(:) + integer, intent(out) :: nlev, nlat, nlon -! TODO: this will be replaced by Ben. -! Vertical localization is done only in height (ZG). -! obs vertical location is given in height (model_interpolate). -! state vertical location is given in height. -subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & - num_close, close_ind, dist, state_handle) - -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) :: state_handle - -integer :: k, q_ind -integer :: n -integer :: istatus - -! n = size(locs) -! -! if (vertical_localization_on()) then ! need to get height -! call convert_vertical_state(state_handle, n, locs, loc_qtys, loc_indx, VERTISHEIGHT, istatus) ! HK Do we care about istatus? -! endif -! -! call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & -! num_close, close_ind, dist) -! -! ! Make the ZG part of the state vector far from everything so it does not get updated. -! ! HK Note if you have inflation on ZG has been inflated. -! ! Scroll through all the obs_loc(:) and obs_kind(:) elements -! -! do k = 1,num_close -! q_ind = close_ind(k) -! if (loc_qtys(q_ind) == QTY_GEOMETRIC_HEIGHT) then -! if (do_output() .and. (debug > 99)) then -! write( * ,*)'get_close_state ZG distance is ', & -! dist(k),' changing to ',10.0_r8 * PI -! write(logfileunit,*)'get_close_state ZG distance is ', & -! dist(k),' changing to ',10.0_r8 * PI -! endif -! dist(k) = 10.0_r8 * PI -! endif -! enddo -! -! -! if (estimate_f10_7) then -! ! f10_7 is given a location of latitude 0.0 and the longitude -! ! of local noon. By decreasing the distance from the observation -! ! to the dynamic f10_7 location we are allowing the already close -! ! observations to have a larger impact in the parameter estimation. -! ! 0.25 is heuristic. The 'close' observations have already been -! ! determined by the cutoff. Changing the distance here does not -! ! allow more observations to impact anything. -! do k = 1, num_close -! q_ind = close_ind(k) -! if (loc_qtys(q_ind) == QTY_1D_PARAMETER) then -! dist(k) = dist(k)*0.25_r8 -! endif -! enddo -! endif -! -! -end subroutine get_close_state + integer :: ncid + character(len=24), parameter :: ROUTINE = 'assign_dimensions' -!================================================================== + call error_handler(E_MSG, ROUTINE, 'reading filter input ['//trim(filter_io_filename)//']') -subroutine convert_vertical_obs(state_handle, num, locs, loc_qtys, loc_types, & - 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, intent(in) :: loc_types(:) -integer, intent(in) :: which_vert -integer, intent(out) :: istatus(:) - -integer :: current_vert_type, i -real(r8) :: height(1) -integer :: local_status(1) - -character(len=*), parameter :: routine = 'convert_vertical_obs' - -! if ( which_vert == VERTISHEIGHT .or. which_vert == VERTISUNDEF) then -! istatus(:) = 0 -! return -! endif -! -! do i = 1, num -! current_vert_type = nint(query_location(locs(i))) -! if (( current_vert_type == which_vert ) .or. & -! ( current_vert_type == VERTISUNDEF)) then -! istatus(i) = 0 -! cycle -! endif -! -! call model_interpolate(state_handle, 1, locs(i), QTY_GEOMETRIC_HEIGHT, height, local_status ) -! -! if (local_status(1) == 0) call set_vertical(locs(i), height(1), VERTISHEIGHT) -! istatus(i) = local_status(1) -! -! enddo -! -end subroutine convert_vertical_obs + ncid = nc_open_file_readonly(filter_io_filename, ROUTINE) -!================================================================== - 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 - - integer :: var_id, dom_id, lon_index, lat_index, lev_index - integer :: i - real(r8) :: height(1), height1(1), height2(1) - character(len=NF90_MAX_NAME) :: dim_name - integer(i8) :: height_idx - - -! if ( which_vert /= VERTISHEIGHT ) then -! call error_handler(E_ERR,'convert_vertical_state', 'only supports VERTISHEIGHT') -! endif -! -! istatus = 0 !HK what are you doing with this? -! -! do i = 1, num -! -! call get_model_variable_indices(loc_indx(i), lon_index, lat_index, lev_index, var_id=var_id, dom_id=dom_id) -! -! ! search for either ilev or lev -! dim_name = ilev_or_lev(dom_id, var_id) -! -! select case (trim(dim_name)) -! case ('ilev') -! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & -! domain_id(SECONDARY_DOM), ivarZG) -! height = get_state(height_idx, state_handle)/100.0_r8 -! -! case (ALT_DIM_NAME) ! height on midpoint -! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index, & -! domain_id(SECONDARY_DOM), ivarZG) -! height1 = get_state(height_idx, state_handle)/100.0_r8 -! height_idx = get_dart_vector_index(lon_index, lat_index, lev_index+1, & -! domain_id(SECONDARY_DOM), ivarZG) -! height2 = get_state(height_idx, state_handle)/100.0_r8 -! height = (height1 + height2) / 2.0_r8 -! -! case default -! call error_handler(E_ERR, 'convert_vertical_state', 'expecting ilev or ilat dimension') -! end select -! -! locs(i) = set_location(lons(lon_index), lats(lat_index), height(1), VERTISHEIGHT) -! -! end do -! -end subroutine convert_vertical_state + ! levels + nlev = nc_get_dimension_size(ncid, trim(LEV_DIM_NAME), ROUTINE) + allocate(levs(nlev)) + call nc_get_variable(ncid, trim(LEV_VAR_NAME), levs, ROUTINE) -!================================================================== + ! latitiude + nlat = nc_get_dimension_size(ncid, trim(LAT_DIM_NAME), ROUTINE) + allocate(lats(nlat)) + call nc_get_variable(ncid, trim(LAT_VAR_NAME), lats, ROUTINE) -function read_model_time(filename) -type(time_type) :: read_model_time -character(len=*), intent(in) :: filename + ! longitude + nlon = nc_get_dimension_size(ncid, trim(LON_DIM_NAME), ROUTINE) + allocate(lons(nlon)) + call nc_get_variable(ncid, trim(LON_VAR_NAME), lons, ROUTINE) -integer :: ncid -integer :: tsimulation ! the time read from a restart file; seconds from aeth_ref_date. -integer :: ndays,nsecs +end subroutine assign_dimensions -character(len=*), parameter :: routine = 'read_model_time' +!-------------------------------------------------------------------- -tsimulation = MISSING_I -ncid = open_block_file(filename, 'read') -call nc_get_variable(ncid, 'time', tsimulation, context=routine) -call nc_close_file(ncid, routine, filename) +subroutine verify_variables(variables, file, nvar, & + var_names, var_qtys, var_ranges, var_update) -! Calculate the DART time of the file time. -! TODO: review calculation of ndays in read_model_time -ndays = tsimulation/86400 -nsecs = tsimulation - ndays*86400 -! Need to subtract 1 because the ref day is not finished. -ndays = aeth_ref_ndays -1 + ndays -read_model_time = set_time(nsecs,ndays) + character(len=*), intent(in) :: variables(:,:) + character(len=*), intent(inout) :: file + integer, intent(out) :: nvar + character(len=*), intent(out) :: var_names(:) + real(r8), intent(out) :: var_ranges(:,:) + logical, intent(out) :: var_update(:) + integer, intent(out) :: var_qtys(:) -if (do_output()) & - call print_time(read_model_time,'read_model_time: time in restart file '//filename) -if (do_output()) & - call print_date(read_model_time,'read_model_time: date in restart file '//filename) + character(len=*), parameter :: routine = 'verify_variables' -if (debug > 8) then - write(string1,*)'tsimulation ',tsimulation - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'ndays ',ndays - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'nsecs ',nsecs - call error_handler(E_MSG,routine,string1,source,revision,revdate) - - call print_date( aeth_ref_time, 'read_model_time:model base date') - call print_time( aeth_ref_time, 'read_model_time:model base time') -endif + integer :: io, i, quantity + real(r8) :: minvalue, maxvalue -end function read_model_time + character(len=vtablenamelength) :: varname + character(len=vtablenamelength) :: dartstr + character(len=vtablenamelength) :: minvalstring + character(len=vtablenamelength) :: maxvalstring + character(len=vtablenamelength) :: state_or_aux + nvar = 0 + MyLoop : do i = 1, size(variables,2) -!=============================================================================== -! Routines below here are private to the module -!=============================================================================== -! Routines for initialization. -!================================================================== +! KDR Why define these intermediate strings? Is the code clearer or faster? + varname = variables(VT_VARNAMEINDX,i) + dartstr = variables(VT_KINDINDX,i) + minvalstring = variables(VT_MINVALINDX,i) + maxvalstring = variables(VT_MAXVALINDX,i) +! KDR The innards of DART expect the VT_ORIGININDX to be an actual NetCDF file name +! But this 'file' variable is not used here (yet?). +! file = variables(VT_ORIGININDX,i) + state_or_aux = variables(VT_STATEINDX,i) + + if ( varname == ' ' .and. dartstr == ' ' ) exit MyLoop ! Found end of list. + + if ( varname == ' ' .or. dartstr == ' ' ) then + error_string_1 = 'model_nml: variable list not fully specified' + error_string_2 = 'reading from "'//trim(filter_io_filename)//'"' + call error_handler(E_ERR,routine, error_string_1, & + source, revision, revdate, text2=error_string_2) + endif + + ! The internal DART routines check if the variable name is valid. + + ! Make sure DART kind is valid + quantity = get_index_for_quantity(dartstr) + if( quantity < 0 ) then + write(error_string_1,'(''there is no obs_kind "'',a,''" in obs_kind_mod.f90'')') & + trim(dartstr) + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + endif + + ! All good to here - fill the output variables + + nvar = nvar + 1 + if (variables(VT_ORIGININDX,i) == 'neutrals') nvar_neutral = nvar_neutral+1 + if (variables(VT_ORIGININDX,i) == 'ions') nvar_ion = nvar_ion+1 + var_names( nvar) = varname + var_qtys( nvar) = quantity + var_ranges(nvar,:) = (/ MISSING_R8, MISSING_R8 /) + var_update(nvar) = .false. ! at least initially + + ! convert the [min,max]valstrings to numeric values if possible + read(minvalstring,*,iostat=io) minvalue + if (io == 0) var_ranges(nvar,1) = minvalue + + read(maxvalstring,*,iostat=io) maxvalue + if (io == 0) var_ranges(nvar,2) = maxvalue + + call to_upper(state_or_aux) + if (state_or_aux == 'UPDATE') var_update(nvar) = .true. + + enddo MyLoop -! Fill up the variable_table from the namelist item 'variables' -! The namelist item variables is where a user specifies -! which variables they want in the DART state: -! variable name, dart qty, clamping min, clamping max, origin file, update or not - -subroutine make_variable_table() - -integer :: nfields_constructed ! number of constructed state variables -integer :: i, nrows, ncols -character(len=*), parameter :: routine = 'read_model_time' - -character(len=NF90_MAX_NAME) :: varname -character(len=NF90_MAX_NAME) :: dartstr -character(len=NF90_MAX_NAME) :: minvalstring -character(len=NF90_MAX_NAME) :: maxvalstring -character(len=NF90_MAX_NAME) :: filename -character(len=NF90_MAX_NAME) :: state_or_aux - -nrows = size(variable_table,1) ! these are MAX_NUM_VARIABLES, MAX_NUM_COLUMNS -ncols = size(variable_table,2) - -! Convert the (input) 1D array "variables" into a table with six columns. -! The number of rows in the table correspond to the number of variables in the -! DART state vector. -! Column 1 is the netCDF variable name. -! Column 2 is the corresponding DART kind. -! Column 3 is the minimum value ("NA" if there is none) Not Applicable -! Column 4 is the maximum value ("NA" if there is none) Not Applicable -! Column 5 is the file of origin aether restart 'neutrals' or 'ions' -! Column 6 is whether or not the variable should be updated in the restart file. - -nfields = 0 -! TODO: TIEGCM uses 3 domains. Aether may need only 1: -! Do we need the 3rd category for derived fields; TEC, ...? -nfields_neutral = 0 -nfields_ion = 0 -nfields_constructed = 0 - -ROWLOOP : do i = 1, nrows - - varname = trim(variables(ncols*i - 5)) - dartstr = trim(variables(ncols*i - 4)) - minvalstring = trim(variables(ncols*i - 3)) - maxvalstring = trim(variables(ncols*i - 2)) - filename = trim(variables(ncols*i - 1)) - state_or_aux = trim(variables(ncols*i )) - -! TODO: should Aether use the 6th column of namelist variable input to handle TEC, ...? - call to_upper(state_or_aux) ! update or not - - variable_table(i,VT_VARNAMEINDX) = trim(varname) - variable_table(i,VT_KINDINDX) = trim(dartstr) - variable_table(i,VT_MINVALINDX) = trim(minvalstring) - variable_table(i,VT_MAXVALINDX) = trim(maxvalstring) - variable_table(i,VT_ORIGININDX) = trim(filename) - variable_table(i,VT_STATEINDX) = trim(state_or_aux) - - ! If the first element is empty, we have found the end of the list. - if ((variable_table(i,1) == ' ') ) exit ROWLOOP - - ! Any other condition is an error. - if ( any(variable_table(i,:) == ' ') ) then - string1 = 'input.nml &model_nml:variables not fully specified.' - string2 = 'Must be 6 entries per variable, last known variable name is' - string3 = trim(variable_table(i,1)) - call error_handler(E_ERR,'get_variables_in_domain',string1, & - source,revision,revdate,text2=string2,text3=string3) - endif -! TODO; Modify this gitm error check for this routine? -! ! Make sure DART kind is valid -! -! 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 - - nfields=nfields+1 - if (trim(variable_table(i,VT_ORIGININDX)) == 'neutrals') then - nfields_neutral = nfields_neutral+1 - else if (trim(variable_table(i,VT_ORIGININDX)) == 'ions') then - nfields_ion = nfields_ion+1 - else if (trim(variable_table(i,VT_ORIGININDX)) == 'CALCULATE') then - nfields_constructed = nfields_constructed + 1 - else - write(string1,'(A,2i5,2A)')'variable_table(',i, VT_ORIGININDX,') = ', & - trim(variable_table(i,VT_ORIGININDX)) - call error_handler(E_ERR,routine,string1,source,revision,revdate) - endif - if ( debug > 0 ) then - write(string1,'("make_variable_table: nfields = ",3(1x,i5))') & - nfields, nfields_neutral, nfields_ion - call error_handler(E_MSG,routine,string1,source,revision,revdate) - endif + if (nvar == MAX_STATE_VARIABLES) then + error_string_1 = 'WARNING: you may need to increase "MAX_STATE_VARIABLES"' + write(error_string_2,'(''you have specified at least '',i4,'' perhaps more.'')') nvar + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate,text2=error_string_2) + endif -enddo ROWLOOP - -! Record the contents of the DART state vector -if (do_output() .and. (debug > 99)) then - do i = 1,nfields - write(*,'(''variable'',i4,'' is '',a12,1x,a32,4(1x,a20))') i, & - trim(variable_table(i,1)), & - trim(variable_table(i,2)), & - trim(variable_table(i,3)), & - trim(variable_table(i,4)), & - trim(variable_table(i,5)), & - trim(variable_table(i,6)) - write(logfileunit,'(''variable'',i4,'' is '',a12,1x,a32,4(1x,a20))') i, & - trim(variable_table(i,1)), & - trim(variable_table(i,2)), & - trim(variable_table(i,3)), & - trim(variable_table(i,4)), & - trim(variable_table(i,5)), & - trim(variable_table(i,6)) - enddo -endif +end subroutine verify_variables -! TODO: Aether may need something like this. -! if (estimate_f10_7) then -! if (nfields_constructed == 0) then -! call error_handler(E_ERR, 'expecting f10.7 in &model_nml::variables', source) -! endif -! call load_up_state_structure_from_file(f10_7_file_name, nfields_constructed, 'CALCULATE', CONSTRUCT_DOM) -! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) & -! + get_domain_size(CONSTRUCT_DOM) -! else -! model_size = get_domain_size(RESTART_DOM) + get_domain_size(SECONDARY_DOM) -! endif -! -end subroutine make_variable_table +!-------------------------------------------------------------------- -!================================================================== +subroutine get_quad_vals(state_handle, ens_size, varid, four_lons, four_lats, & + lon_lat_vert, which_vert, quad_vals, istatus) -! Read the lon, lat, and alt arrays from the ncid + type(ensemble_type), intent(in) :: state_handle + integer, intent(in) :: ens_size + integer, intent(in) :: varid + integer, intent(in) :: four_lons(4), 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) + integer, intent(out) :: istatus(ens_size) -subroutine get_grid_from_netcdf(lons, lats, alts ) + real(r8) :: vert_val + integer :: lev1, lev2, stat, integer_level + real(r8) :: vert_fract + character(len=512) :: error_string_1 -real(r8), intent(inout) :: lons(:) -real(r8), intent(inout) :: lats(:) -real(r8), intent(inout) :: alts(:) + character(len=*), parameter :: routine = 'get_quad_vals' -character(len=*), parameter :: routine = 'get_grid_from_netcdf' + quad_vals(:,:) = MISSING_R8 + istatus(:) = GENERAL_ERROR_CODE -integer :: ncid + vert_val = lon_lat_vert(3) -ncid = nc_open_file_readonly(filter_io_filename, routine) + if ( which_vert == VERTISHEIGHT ) then + call find_enclosing_indices(nlev, levs(:), vert_val, lev1, lev2, & + vert_fract, stat, log_scale = .false.) -call nc_get_variable(ncid, LON_VAR_NAME, lons, context=routine) -call nc_get_variable(ncid, LAT_VAR_NAME, lats, context=routine) -call nc_get_variable(ncid, ALT_VAR_NAME, alts, context=routine) + if (stat /= 0) then + istatus = INVALID_ALTITUDE_VAL_ERROR_CODE + end if + else + istatus(:) = INVALID_VERT_COORD_ERROR_CODE + write(error_string_1, *) 'unsupported vertical type: ', which_vert + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + endif -call nc_close_file(ncid) + ! 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. -end subroutine get_grid_from_netcdf + if (varid > 0) then -!================================================================= + call get_four_state_values(state_handle, ens_size, four_lons, four_lats, & + lev1, lev2, vert_fract, varid, quad_vals, & + istatus) + else + write(error_string_1, *) 'unsupported variable: ', varid + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + endif -subroutine static_init_blocks(nml) + if (any(istatus /= 0)) return -character(len=*), intent(in) :: nml + ! when you get here, istatus() was set either by passing it to a + ! subroutine, or setting it explicitly here. +end subroutine get_quad_vals -character(len=128) :: aether_filename +!----------------------------------------------------------------------- +!> 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 -character(len=*), parameter :: routine = 'static_init_blocks' +subroutine vert_interp(nitems, levs1, levs2, vert_fract, out_vals) -integer :: iunit, io -!logical :: has_gitm_namelist +integer, intent(in) :: nitems +real(r8), intent(in) :: levs1(nitems) +real(r8), intent(in) :: levs2(nitems) +real(r8), intent(in) :: vert_fract +real(r8), intent(out) :: out_vals(nitems) -if (module_initialized) return ! only need to do this once +out_vals(:) = (levs1(:) * (1.0_r8-vert_fract)) + & +(levs2(:) * vert_fract) -! This prevents subroutines called from here from calling static_init_mod. -module_initialized = .true. +end subroutine vert_interp -!---------------------------------------------------------------------- -! Read the aether_to_dart namelist -!---------------------------------------------------------------------- -! NEWIC; a2d will now read 'variables' from its own namelist. -! I think/hope that a2d doesn't need any other variables from model_nml. - -! TODO: filter_io_dir from here instead of redundant entry in model_mod_nml? -call find_namelist_in_file("input.nml", trim(nml), iunit) -if (trim(nml) == 'aether_to_dart_nml') then - read(iunit, nml = aether_to_dart_nml, iostat = io) - ! Record the namelist values used for the run - if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) - if (do_nml_term()) write( * , nml=aether_to_dart_nml) -else if (trim(nml) == 'dart_to_aether_nml') then - read(iunit, nml = dart_to_aether_nml, iostat = io) - ! Record the namelist values used for the run - if (do_nml_file()) write(nmlfileunit, nml=dart_to_aether_nml) - if (do_nml_term()) write( * , nml=dart_to_aether_nml) -endif -call check_namelist_read(iunit, io, trim(nml)) ! closes, too. +!-------------------------------------------------------------------- +subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & + lev1, lev2, vert_fract, varid, quad_vals, & + istatus) -! error-check, convert namelist input to variable_table, and build the state structure -! 'variables' comes from aether_to_dart_nml -call make_variable_table() + type(ensemble_type), intent(in) :: state_handle + integer, intent(in) :: ens_size + integer, intent(in) :: four_lons(4), four_lats(4) + integer, intent(in) :: lev1, lev2 + real(r8), intent(in) :: vert_fract + integer, intent(in) :: varid + real(r8), intent(out) :: quad_vals(4, ens_size) !< array of interpolated values + integer, intent(out) :: istatus(ens_size) -!--------------------------------------------------------------- -! TODO: Set the time step -! Ensures model_advance_time is multiple of 'dynamics_timestep' + integer :: icorner + real(r8) :: vals1(ens_size), vals2(ens_size) + real(r8) :: qvals(ens_size) -!TODO: Aether uses Julian time internally -! andor a Julian calendar (days from the start of the calendar), depending on the context) -call set_calendar_type( calendar ) ! comes from model_mod_nml + integer(i8) :: state_indx -!--------------------------------------------------------------- -! 1) get grid dimensions -! 2) allocate space for the grids -! 3) read them from the block restart files, could be stretched ... + character(len=*), parameter :: routine = 'get_four_state_values:' -call get_grid_info_from_blocks(aether_restart_dirname, nlon, nlat, nalt, nBlocksLon, & - nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) + do icorner=1, 4 -if( debug > 0 ) then - write(string1,*) 'grid dims are ',nlon,nlat,nalt - call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif +! KDR Most rapidly varying dim must be first +! state_indx = get_dart_vector_index(four_lons(icorner), four_lats(icorner), & +! lev1, dom_id, varid) + state_indx = get_dart_vector_index(lev1 ,four_lats(icorner), & + four_lons(icorner), dom_id, varid) + + if (state_indx < 0) then + write(error_string_1,*) 'Could not find dart state index from ' +! KDR original printed lev2, even though it has not been used yet. + write(error_string_2,*) 'lon, lat, and lev1(,2) index :', four_lons(icorner), four_lats(icorner), & + lev1,lev2 + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate,text2=error_string_2) + return + endif + + vals1(:) = get_state(state_indx, state_handle) ! all the ensemble members for level (i) + + state_indx = get_dart_vector_index(lev2, four_lats(icorner), & + four_lons(icorner), dom_id, varid) + + if (state_indx < 0) then + write(error_string_1,*) 'Could not find dart state index from ' + write(error_string_2,*) 'lon, lat, and lev index :', four_lons(icorner), four_lats(icorner), lev2 + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate,text2=error_string_2) + return + endif + + vals2(:) = get_state(state_indx, state_handle) ! all the ensemble members for level (i) + + ! if directly using quad_vals here, it would create a temporary array and give a warning + call vert_interp(ens_size, vals1, vals2, vert_fract, qvals) + quad_vals(icorner, :) = qvals + enddo -! Opens and closes the grid block file, but not the filter netcdf file. -call get_grid_from_blocks(aether_restart_dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & - nxPerBlock, nyPerBlock, nzPerBlock, lons, lats, alts ) + istatus = 0 -! Convert the Aether reference date (not calendar day = 0 date) -! to the days and seconds of the calendar set in model_mod_nml. -aeth_ref_time = set_date(aeth_ref_date(1), aeth_ref_date(2), aeth_ref_date(3), & - aeth_ref_date(4), aeth_ref_date(5)) -call get_time(aeth_ref_time,aeth_ref_nsecs,aeth_ref_ndays) +end subroutine get_four_state_values -! Get the model time from a restart file. -aether_filename = block_file_name(variable_table(1,VT_ORIGININDX), 0, 0) -state_time = read_model_time(trim(aether_restart_dirname)//'/'//trim(aether_filename)) +!================================================================== -! TODO: Replace verify_block_variables+decode_gitm_indices with aether variables check? (OR is that done when trying to read them from NetCDF?) +!> 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 + +subroutine ok_to_interpolate(qty, varid, istatus) + + integer, intent(in) :: qty + integer, intent(out) :: varid + integer, intent(out) :: istatus + + ! See if the state contains the obs quantity + varid = get_varid_from_kind(dom_id, qty) + + ! in the state vector + if (varid > 0) then + istatus = 0 + return + endif + + ! add any quantities that can be interpolated to this list if they + ! are not in the state vector. + select case (qty) + case (QTY_GEOMETRIC_HEIGHT) + istatus = 0 + case default + istatus = UNKNOWN_OBS_QTY_ERROR_CODE + end select + +end subroutine ok_to_interpolate + +!-------------------------------------------------------------------- +!> Converts Aether restart files to a netCDF file +!> +!> This routine needs: +!> +!> 1. A base dirname for the restart files (restart_dirname). +!> they will have the format 'dirname/{neutrals,ions}_mMMMM_gBBBB.rst' +!> where BBBB is the block number, MMMM is the member number, +!> and they have leading 0s. Blocks start in the +!> southwest corner of the lat/lon grid and go east first, +!> then to the west end of the next row north and end in the northeast corner. +!> +!> In the process, the routine will find: +!> +!> 1. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. +!> (nBlocksLon, nBlocksLat, 1) +!> +!> 2. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) +!> +!> 3. The number of lon/lats in a single grid block (nxPerBlock, +!> nyPerBlock, nzPerBlock) +!> +!> 4. The number of neutral species (and probably a mapping between +!> the species number and the variable name) (nSpeciesTotal, nSpecies) +!> +!> 5. The number of ion species (ditto - numbers <-> names) (nIons) +!> +!> In addition to reading in the state data, it fills Longitude, Latitude, and Altitude arrays. +!> This grid is orthogonal and rectangular but can have irregular spacing along +!> any of the three dimensions. -if ( debug > 0 ) then - write(string1,'("grid: nlon, nlat, nalt =",3(1x,i5))') nlon, nlat, nalt - call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif +subroutine restart_files_to_netcdf(member) -end subroutine static_init_blocks + ! TODO: Does restart_files_to_netcdf need restart_dir? + integer, intent(in) :: member + + integer :: ncid + + character(len=*), parameter :: routine = 'restart_files_to_netcdf' + + if (module_initialized ) then + write(error_string_1,*)'The aether static_init_model was already initialized but ',trim(routine),& + ' uses a separate initialization procedure' + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + end if + + call static_init_blocks("aether_to_dart_nml") + + write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member+1,'.nc' + ! nc_create_file does not leave define mode + ncid = nc_create_file(filter_io_filename) + + call error_handler(E_MSG, '', '') + write(error_string_1,*) 'converting Aether restart files in directory ', & + "'"//trim(aether_restart_dirname)//"'" + write(error_string_2,*) ' to the NetCDF file ', "'"//trim(filter_io_filename)//"'" + call error_handler(E_MSG, routine, error_string_1, text2=error_string_2) + call error_handler(E_MSG, '', '') + +! Debug time UNLIM + ! Enters and exits define mode; + ! nc_write_model_atts puts it in define mode. Is it already there? + ! Then it takes it out of define and leaves file open. + call nc_write_model_atts(ncid, 0) + + ! Write_model_time will make a time variable, if needed, which it is not. + ! write_model_time does not open the file, + call write_model_time(ncid, state_time) + + call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) + + ! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts + ! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying + ! the state vector field names and source. + ! call add_nc_dimvars(ncid) + + call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) + ! subr. called by this routine closes the file only if define = .true. + + call nc_close_file(ncid) + + call error_handler(E_MSG, '', '') + write(error_string_1,*) 'Successfully converted the Aether restart files to ', & + "'"//trim(filter_io_filename)//"'" + call error_handler(E_MSG, routine, error_string_1) + call error_handler(E_MSG, '', '') + + +end subroutine restart_files_to_netcdf + +!================================================================= +! Writes the current time and state variables from a dart state +! vector (1d array) into a gitm netcdf restart file. -!================================================================== +subroutine netcdf_to_restart_files(member) + + integer, intent(in) :: member + + integer :: ncid + character(len=*), parameter :: routine = 'netcdf_to_restart_files:' + +! write out the state vector data. +! when this routine returns all the data has been written. + + if (module_initialized ) then + write(error_string_1,*)'The gitm mod was already initialized but ',trim(routine),& + ' uses a separate initialization procedure' + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + end if + + call static_init_blocks("dart_to_aether_nml") + + write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member+1,'.nc' + + call error_handler(E_MSG,routine,'','',revision,revdate) + write(error_string_1,*) 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" + write(error_string_2,*) 'into Aether restart files in directory ', "'"//trim(aether_restart_dirname)//"'" + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate,text2=error_string_2) + + ncid = nc_open_file_readonly(filter_io_filename, routine) + + call filter_to_restarts(ncid, member) + + !---------------------------------------------------------------------- + ! Log what we think we're doing, and exit. + !---------------------------------------------------------------------- + call error_handler(E_MSG,routine,'','',revision,revdate) + write(error_string_1,*) 'Successfully converted to the Aether restart files in directory' + write(error_string_2,*) "'"//trim(aether_restart_dirname)//"'" + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate,text2=error_string_2) + + call nc_close_file(ncid) + +end subroutine netcdf_to_restart_files -subroutine read_model_namelist() +!-------------------------------------------------------------------- -integer :: iunit, io +function block_file_name(filetype, memnum, blocknum) -! 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') + character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} + ! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? + ! This code can handle it; a longer filetype passed in, and no member. + ! ? output files? + integer, intent(in) :: blocknum + integer, intent(in) :: memnum + character(len=128) :: block_file_name + character(len=*), parameter :: routine = 'block_file_name' + + block_file_name = trim(filetype) + if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum + if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum + block_file_name = trim(block_file_name)//'.nc' + if ( debug > 0 ) then + write(error_string_1,'("filename, memnum, blocknum = ",A,2(1x,i5))') & + trim(block_file_name), memnum, blocknum + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif + +end function block_file_name -! 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) +!-------------------------------------------------------------------- -end subroutine read_model_namelist +subroutine static_init_blocks(nml) -!================================================================== + character(len=*), intent(in) :: nml + + character(len=128) :: aether_filter_io_filename + + character(len=*), parameter :: routine = 'static_init_blocks' + + character(len=vtablenamelength) :: varname + integer :: iunit, io, ivar + !logical :: has_gitm_namelist + + if (module_initialized) return ! only need to do this once + + ! This prevents subroutines called from here from calling static_init_mod. + module_initialized = .true. + + !---------------------------------------------------------------------- + ! Read the aether_to_dart namelist + !---------------------------------------------------------------------- + ! NEWIC; a2d will now read 'variables' from its own namelist. + ! I think/hope that a2d doesn't need any other variables from model_nml. + + ! TODO: filter_io_dir from here instead of redundant entry in model_mod_nml? + call find_namelist_in_file("input.nml", trim(nml), iunit) + if (trim(nml) == 'aether_to_dart_nml') then + read(iunit, nml = aether_to_dart_nml, iostat = io) + ! Record the namelist values used for the run + if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) + if (do_nml_term()) write( * , nml=aether_to_dart_nml) + else if (trim(nml) == 'dart_to_aether_nml') then + read(iunit, nml = dart_to_aether_nml, iostat = io) + ! Record the namelist values used for the run + if (do_nml_file()) write(nmlfileunit, nml=dart_to_aether_nml) + if (do_nml_term()) write( * , nml=dart_to_aether_nml) + endif + call check_namelist_read(iunit, io, trim(nml)) ! closes, too. + + + ! error-check, convert namelist input to variables, and build the state structure + ! 'variables' comes from model_nml in input.nml + call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) + + !--------------------------------------------------------------- + ! TODO: Set the time step + ! Ensures model_advance_time is multiple of 'dynamics_timestep' + + !TODO: Aether uses Julian time internally + ! andor a Julian calendar (days from the start of the calendar), depending on the context) + call set_calendar_type( calendar ) ! comes from model_mod_nml + + !--------------------------------------------------------------- + ! 1) get grid dimensions + ! 2) allocate space for the grids + ! 3) read them from the block restart files, could be stretched ... + + call get_grid_info_from_blocks(aether_restart_dirname, nlon, nlat, nlev, nblocks_lon, & + nblocks_lat, nblocks_lev, lat_start, lat_end, lon_start) + + if( debug > 0 ) then + write(error_string_1,*) 'grid dims are ',nlon,nlat,nlev + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif + + ! Opens and closes the grid block file, but not the filter netcdf file. + call get_grid_from_blocks(aether_restart_dirname, nblocks_lon, nblocks_lat, nblocks_lev, & + nx_per_block, ny_per_block, nz_per_block, lons, lats, levs ) + + ! Convert the Aether reference date (not calendar day = 0 date) + ! to the days and seconds of the calendar set in model_mod_nml. + aether_ref_time = set_date(aether_ref_date(1), aether_ref_date(2), aether_ref_date(3), & + aether_ref_date(4), aether_ref_date(5)) + call get_time(aether_ref_time,aether_ref_nsecs,aether_ref_ndays) + + ! Get the model time from a restart file. + aether_filter_io_filename = block_file_name(variables(VT_ORIGININDX,1), 0, 0) + state_time = read_aether_time(trim(aether_restart_dirname)//'/'//trim(aether_filter_io_filename)) + + if ( debug > 0 ) then + write(error_string_1,'("grid: nlon, nlat, nlev =",3(1x,i5))') nlon, nlat, nlev + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif + +end subroutine static_init_blocks -!> Read the grid dimensions from a restart netcdf file. -!> -!> The file name comes from module storage ... namelist. +!-------------------------------------------------------------------- subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, & - nalt, nBlocksLon, nBlocksLat, nBlocksAlt, LatStart, LatEnd, LonStart) + nlev, nblocks_lon, nblocks_lat, nblocks_lev, lat_start, lat_end, lon_start) -character(len=*), intent(in) :: restart_dirname -integer, intent(out) :: nlon ! Number of Longitude centers -integer, intent(out) :: nlat ! Number of Latitude centers -integer, intent(out) :: nalt ! Number of Vertical grid centers -integer, intent(out) :: nBlocksLon, nBlocksLat, nBlocksAlt -real(r8), intent(out) :: LatStart, LatEnd, LonStart + character(len=*), intent(in) :: restart_dirname + integer, intent(out) :: nlon ! Number of Longitude centers + integer, intent(out) :: nlat ! Number of Latitude centers + integer, intent(out) :: nlev ! Number of Vertical grid centers + integer, intent(out) :: nblocks_lon, nblocks_lat, nblocks_lev + real(r8), intent(out) :: lat_start, lat_end, lon_start -! TODO: get the grid info from a namelists (98 variables), instead of GITM's UAM.in. -! Then remove functions read_in_*. -! The rest of the UAM.in contents are for running GITM. -! Can wait until aether_to_dart push is done. -character(len=*), parameter :: filename = 'UAM.in' + ! TODO: get the grid info from a namelists (98 variables), instead of GITM's UAM.in. + ! Then remove functions read_in_*. + ! The rest of the UAM.in contents are for running GITM. + ! Can wait until aether_to_dart push is done. + character(len=*), parameter :: filename = 'UAM.in' -character(len=100) :: cLine ! iCharLen_ == 100 -character(len=256) :: fileloc + character(len=100) :: cline ! iCharLen_ == 100 + character(len=256) :: file_loc -integer :: i, iunit, ios + integer :: i, iunit, ios -character(len=*), parameter :: routine = 'get_grid_info_from_blocks' + character(len=*), parameter :: routine = 'get_grid_info_from_blocks' -! get the ball rolling ... + ! get the ball rolling ... -nBlocksLon = 0 -nBlocksLat = 0 -nBlocksAlt = 0 -LatStart = 0.0_r8 -LatEnd = 0.0_r8 -LonStart = 0.0_r8 + nblocks_lon = 0 + nblocks_lat = 0 + nblocks_lev = 0 + lat_start = 0.0_r8 + lat_end = 0.0_r8 + lon_start = 0.0_r8 -write(fileloc,'(a,''/'',a)') trim(restart_dirname),trim(filename) + write(file_loc,'(a,''/'',a)') trim(restart_dirname),trim(filename) -if (debug > 4) then - write(string1,*) 'Now opening Aether UAM file: ',trim(fileloc) - call error_handler(E_MSG,routine,string1,source,revision,revdate) -end if + if (debug > 4) then + write(error_string_1,*) 'Now opening Aether UAM file: ',trim(file_loc) + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + end if -iunit = open_file(trim(fileloc), action='read') + iunit = open_file(trim(file_loc), action='read') -UAMREAD : do i = 1, 1000000 + UAMREAD : do i = 1, 1000000 - read(iunit,'(a)',iostat=ios) cLine + read(iunit,'(a)',iostat=ios) cLine - if (ios /= 0) then - ! If we get to the end of the file or hit a read error without - ! finding what we need, die. - write(string1,*) 'cannot find #GRID in ',trim(fileloc) - call error_handler(E_ERR,'get_grid_info_from_blocks',string1,source,revision,revdate) - endif - - if (cLine(1:5) .ne. "#GRID") cycle UAMREAD - - nBlocksLon = read_in_int( iunit,'NBlocksLon',trim(fileloc)) - nBlocksLat = read_in_int( iunit,'NBlocksLat',trim(fileloc)) - nBlocksAlt = read_in_int( iunit,'NBlocksAlt',trim(fileloc)) - LatStart = read_in_real(iunit,'LatStart', trim(fileloc)) - LatEnd = read_in_real(iunit,'LatEnd', trim(fileloc)) - LonStart = read_in_real(iunit,'LonStart', trim(fileloc)) - - exit UAMREAD - -enddo UAMREAD - -if (debug > 4) then - write(string1,*) 'Successfully read Aether UAM grid file:',trim(fileloc) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nBlocksLon:',nBlocksLon - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nBlocksLat:',nBlocksLat - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nBlocksAlt:',nBlocksAlt - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' LatStart:',LatStart - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' LatEnd:',LatEnd - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' LonStart:',LonStart - call error_handler(E_MSG,routine,string1,source,revision,revdate) -end if - -call close_file(iunit) - -end subroutine get_grid_info_from_blocks - -!================================================================== - -function read_in_int(iunit,varname,filename) - -integer, intent(in) :: iunit -character(len=*), intent(in) :: varname,filename -integer :: read_in_int - -character(len=100) :: cLine -integer :: i, ios - -! Read a line -read(iunit,'(a)',iostat=ios) cLine -if (ios /= 0) then - write(string1,*) 'cannot find '//trim(varname)//' in '//trim(filename) - call error_handler(E_ERR,'get_grid_dims',string1,source,revision,revdate) -endif - -! Remove anything after a space or TAB -i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' -i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' - -read(cLine,*,iostat=ios)read_in_int - -if(ios /= 0) then - write(string1,*)'unable to read '//trim(varname)//' in '//trim(filename) - call error_handler(E_ERR,'read_in_int',string1,source,revision,revdate,& - text2=cLine) -endif - -end function read_in_int - -!================================================================= - -function read_in_real(iunit,varname,filename) + if (ios /= 0) then + ! If we get to the end of the file or hit a read error without + ! finding what we need, die. + write(error_string_1,*) 'cannot find #GRID in ',trim(file_loc) + call error_handler(E_ERR,'get_grid_info_from_blocks',error_string_1,source,revision,revdate) + endif -integer, intent(in) :: iunit -character(len=*), intent(in) :: varname,filename -real(r8) :: read_in_real + if (cLine(1:5) .ne. "#GRID") cycle UAMREAD -character(len=100) :: cLine -integer :: i, ios + nblocks_lon = read_in_int( iunit,'nblocks_lon',trim(file_loc)) + nblocks_lat = read_in_int( iunit,'nblocks_lat',trim(file_loc)) + nblocks_lev = read_in_int( iunit,'nblocks_lev',trim(file_loc)) + lat_start = read_in_real(iunit,'lat_start', trim(file_loc)) + lat_end = read_in_real(iunit,'lat_end', trim(file_loc)) + lon_start = read_in_real(iunit,'lon_start', trim(file_loc)) -! Read a line -read(iunit,'(a)',iostat=ios) cLine -if (ios /= 0) then - write(string1,*) 'cannot find '//trim(varname)//' in '//trim(filename) - call error_handler(E_ERR,'get_grid_dims',string1,source,revision,revdate) -endif + exit UAMREAD -! Remove anything after a space or TAB -i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' -i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' + enddo UAMREAD -! Now that we have a line with nothing else ... parse it -read(cLine,*,iostat=ios)read_in_real + if (debug > 4) then + write(error_string_1,*) 'Successfully read Aether UAM grid file:',trim(file_loc) + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' nblocks_lon:',nblocks_lon + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' nblocks_lat:',nblocks_lat + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' nblocks_lev:',nblocks_lev + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' lat_start:',lat_start + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' lat_end:',lat_end + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' lon_start:',lon_start + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + end if -if(ios /= 0) then - write(string1,*)'unable to read '//trim(varname)//' in '//trim(filename) - call error_handler(E_ERR,'read_in_real',string1,source,revision,revdate) -endif + call close_file(iunit) -end function read_in_real - -!================================================================= -! Routines for aether_to_dart. -!================================================================== +end subroutine get_grid_info_from_blocks -!----------------------------------------------------------------------------- -! Translate an Aether field name (not CF-compliant) into a form filter likes. -! E.g. 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', -> -! 'Opos_Perp_Ion_Velocity_Meridional' - -function aeth_name_to_dart(varname) - -! TODO: NF90_MAX_NAME was not usable in the test program. Usable in model_mod? -! character(len=NF90_MAX_NAME), intent(in) :: varname -character(len=256), intent(in) :: varname - -! character(len=NF90_MAX_NAME) :: aeth -character(len=256) :: aeth -character(len=128) :: aeth_name_to_dart -character(len=64) :: parts(8), var_root -integer :: char_num, first, i_parts, aeth_len, end_str - -aeth = trim(varname) -aeth_len = len_trim(varname) -parts = '' - -! Look for the last ' '. The characters after that are the species. -! If there's no ' ', the whole string is the species. -char_num = 0 -char_num = scan(trim(aeth),' ',back=.true.) -var_root = aeth(char_num+1:aeth_len) -! purge_chars removes unwanted [()\] -parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) -! print*,'var_root, parts(1) = ',var_root, parts(1) -end_str = char_num - -! Tranform remaining pieces of varname into DART versions. -char_num = MISSING_I -first = 1 -i_parts = 2 -do - ! This returns the position of the first blank *within the substring* passed in. - char_num = scan(aeth(first:end_str),' ',back=.false.) - if (char_num > 0 .and. first < aeth_len) then - parts(i_parts) = purge_chars(aeth(first:first+char_num-1), '.)(\', plus_minus=.true.) - - first = first + char_num - i_parts = i_parts + 1 - else - exit - endif -enddo - -! Construct the DART field name from the parts -aeth_name_to_dart = trim(parts(1)) -i_parts = 2 -do -if (trim(parts(i_parts)) /= '') then - aeth_name_to_dart = trim(aeth_name_to_dart)//'_'//trim(parts(i_parts)) - i_parts = i_parts + 1 -else - exit -endif -enddo +!-------------------------------------------------------------------- + +subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, & + nx_per_block, ny_per_block, nz_per_block, & + lons, lats, levs ) + + character(len=*), intent(in) :: dirname + integer, intent(in) :: nblocks_lon ! Number of Longitude blocks + integer, intent(in) :: nblocks_lat ! Number of Latitude blocks + integer, intent(in) :: nblocks_lev ! Number of Altitude blocks + integer, intent(out) :: nx_per_block ! Number of non-halo Longitude centers per block + integer, intent(out) :: ny_per_block ! Number of non-halo Latitude centers per block + integer, intent(out) :: nz_per_block ! Number of Vertical grid centers + + real(r8), allocatable , dimension( : ), intent(inout) :: lons, lats, levs + + integer :: ios, nb, offset, ncid, nboff + character(len=128) :: filename + real(r4), allocatable :: temp(:,:,:) + integer :: starts(3),ends(3), xcount, ycount, zcount + + character(len=*), parameter :: routine = 'get_grid_from_blocks' + + ! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), + ! in order to calculate the n[xyz]PerBlock dimensions. + ! grid_g0000.nc looks like a worthy candidate, but a restart could be used. + write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' + ncid = nc_open_file_readonly(filename, routine) + + ! The grid (and restart) file variables have halos, so strip them off + ! to get the number of actual data values in each dimension of the block. + nx_per_block = nc_get_dimension_size(ncid, 'x', routine) - 2*nghost + ny_per_block = nc_get_dimension_size(ncid, 'y', routine) - 2*nghost + nz_per_block = nc_get_dimension_size(ncid, 'z', routine) + + nlon = nblocks_lon * nx_per_block + nlat = nblocks_lat * ny_per_block + nlev = nblocks_lev * nz_per_block + + write(error_string_1,*) 'nlon = ', nlon + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) 'nlat = ', nlat + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) 'nlev = ', nlev + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + + ! TODO; do these need to be deallocated somewhere? + allocate( lons( nlon )) + allocate( lats( nlat )) + allocate( levs( nlev )) + + if (debug > 4) then + write(error_string_1,*) 'Successfully read GITM grid file:',trim(filename) + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' nx_per_block:',nx_per_block + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' ny_per_block:',ny_per_block + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*) ' nz_per_block:',nz_per_block + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif + + ! A temp array large enough to hold any of the 3D + ! Lon,Lat or Alt arrays from a block plus ghost cells. + ! The restart files have C-indexing (fastest changing dim is the last). + allocate(temp( 1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) +! TODO; use MISSING_R4 instead? + temp = -888888. + + + starts(1) = 1-nghost + starts(2) = 1-nghost + starts(3) = 1 + ends(1) = nx_per_block+nghost + ends(2) = ny_per_block+nghost + ends(3) = nz_per_block + xcount = nx_per_block + 2*nghost + ycount = ny_per_block + 2*nghost + zcount = nz_per_block + if ( debug > 0 ) then + write(error_string_1,'(2(A,3i5),A,3(1X,i5))') & + 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif + + ! go across the south-most block row picking up all longitudes + do nb = 1, nblocks_lon + + ! filename is trimmed by passage to open_block_file + "len=*" there. + filename = block_file_name('grid', -1, nb-1) + ncid = open_block_file(filename, 'read') + + ! Read 3D array and extract the longitudes of the non-halo data of this block. + ! The restart files have C-indexing (fastest changing dim is the last), + ! So invert the dimension bounds. + call nc_get_variable(ncid, 'Longitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + context=routine, & + nc_count=(/zcount,ycount,xcount/)) + + offset = (nx_per_block * (nb - 1)) + lons(offset+1:offset+nx_per_block) = temp(1,1,1:nx_per_block) + + call nc_close_file(ncid) + enddo -end function aeth_name_to_dart + ! go up west-most block row picking up all latitudes + do nb = 1, nblocks_lat -!----------------------------------------------------------------- -! Replace undesirable characters with better. + ! TODO; Aether block name counters start with 0, but the lat values can come from + ! any lon=const column. + nboff = ((nb - 1) * nblocks_lon) + filename = block_file_name('grid', -1, nboff) + ncid = open_block_file(filename, 'read') + + call nc_get_variable(ncid, 'Latitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + context=routine, nc_count=(/zcount,ycount,xcount/)) + + + offset = (ny_per_block * (nb - 1)) + lats(offset+1:offset+ny_per_block) = temp(1,1:ny_per_block,1) + + call nc_close_file(ncid) + enddo -function purge_chars(ugly_string, chars, plus_minus) -character (len=*), intent(in) :: ugly_string, chars -logical, intent(in) :: plus_minus -character (len=64) :: purge_chars -character (len=256) :: temp_str - -integer :: char_num, end_str, pm_num - -! Trim is not needed here -temp_str = ugly_string -end_str = len_trim(temp_str) -char_num = MISSING_I -do - ! Returns 0 if chars are not found - char_num = scan(temp_str,chars) - ! Need to change it to a char that won't be found by scan in the next iteration, - ! and can be easily removed. - if (char_num > 0) then - ! Squeeze out the character - temp_str(char_num:end_str-1) = temp_str(char_num+1:end_str) - temp_str(end_str:end_str) = '' -! temp_str(char_num:char_num) = ' ' - else - exit - endif -enddo - -! Replace + and - with pos and neg. Assume there's only 1. -temp_str = trim(adjustl(temp_str)) -end_str = len_trim(temp_str) -pm_num = scan(trim(temp_str),'+-',back=.false.) -if (pm_num == 0 .or. .not. plus_minus) then - purge_chars = trim(temp_str) -else - if (temp_str(pm_num:pm_num) == '+') then - purge_chars = temp_str(1:pm_num-1)//'pos' - else if (temp_str(pm_num:pm_num) == '-') then - purge_chars = temp_str(1:pm_num-1)//'neg' - endif - if (pm_num+1 <= end_str) & - purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) -endif + ! this code assumes UseTopography is false - that all columns share + ! the same altitude array, so we can read it from the first block. + ! if this is not the case, this code has to change. -end function purge_chars + filename = block_file_name('grid', -1, 0) + ncid = open_block_file(filename, 'read') -!----------------------------------------------------------------- -! open enough of the restart files to read in the lon, lat, alt arrays - -subroutine get_grid_from_blocks(dirname, nBlocksLon, nBlocksLat, nBlocksAlt, & - nxPerBlock, nyPerBlock, nzPerBlock, & - lons, lats, alts ) - -character(len=*), intent(in) :: dirname -integer, intent(in) :: nBlocksLon ! Number of Longitude blocks -integer, intent(in) :: nBlocksLat ! Number of Latitude blocks -integer, intent(in) :: nBlocksAlt ! Number of Altitude blocks -integer, intent(out) :: nxPerBlock ! Number of non-halo Longitude centers per block -integer, intent(out) :: nyPerBlock ! Number of non-halo Latitude centers per block -integer, intent(out) :: nzPerBlock ! Number of Vertical grid centers - -real(r8), allocatable , dimension( : ), intent(inout) :: lons, lats, alts - -integer :: nb, offset, ncid, nboff -character(len=128) :: filename -real(r4), allocatable :: temp(:,:,:) -integer :: starts(3),ends(3), xcount, ycount, zcount - -character(len=*), parameter :: routine = 'get_grid_from_blocks' - -! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), -! in order to calculate the n[xyz]PerBlock dimensions. -! grid_g0000.nc looks like a worthy candidate, but a restart could be used. -write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' -ncid = nc_open_file_readonly(filename, routine) - -! The grid (and restart) file variables have halos, so strip them off -! to get the number of actual data values in each dimension of the block. -nxPerBlock = nc_get_dimension_size(ncid, 'x', routine) - 2*nGhost -nyPerBlock = nc_get_dimension_size(ncid, 'y', routine) - 2*nGhost -nzPerBlock = nc_get_dimension_size(ncid, 'z', routine) - -nlon = nBlocksLon * nxPerBlock -nlat = nBlocksLat * nyPerBlock -nalt = nBlocksAlt * nzPerBlock - -write(string1,*) 'nlon = ', nlon -call error_handler(E_MSG,routine,string1,source,revision,revdate) -write(string1,*) 'nlat = ', nlat -call error_handler(E_MSG,routine,string1,source,revision,revdate) -write(string1,*) 'nalt = ', nalt -call error_handler(E_MSG,routine,string1,source,revision,revdate) - -! This is also done in gitm's static_init_model, which is not called by aether_to_dart, -! so it's not redundant. -! TODO; do these need to be deallocated somewhere? -allocate( lons( nlon )) -allocate( lats( nlat )) -allocate( alts( nalt )) - -if (debug > 4) then - write(string1,*) 'Successfully read GITM grid file:',trim(filename) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nxPerBlock:',nxPerBlock - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nyPerBlock:',nyPerBlock - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*) ' nzPerBlock:',nzPerBlock - call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif + temp = MISSING_R8 + call nc_get_variable(ncid, 'Altitude', & + temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & + context=routine, nc_count=(/zcount,ycount,xcount/)) -! A temp array large enough to hold any of the 3D -! Lon,Lat or Alt arrays from a block plus ghost cells. -! The restart files have C-indexing (fastest changing dim is the last). -allocate(temp( 1:nzPerBlock, & - 1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost)) -! TODO; use MISSING_R4 instead? -temp = -888888. - - -starts(1) = 1-nGhost -starts(2) = 1-nGhost -starts(3) = 1 -ends(1) = nxPerBlock+nGhost -ends(2) = nyPerBlock+nGhost -ends(3) = nzPerBlock -xcount = nxPerBlock + 2*nGhost -ycount = nyPerBlock + 2*nGhost -zcount = nzPerBlock -if ( debug > 0 ) then - write(string1,'(3(A,i5),2(1X,i5))') & - 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount - call error_handler(E_MSG,routine,string1,source,revision,revdate) -endif + levs(1:nz_per_block) = temp(1:nz_per_block,1,1) -! go across the south-most block row picking up all longitudes -do nb = 1, nBlocksLon + call nc_close_file(ncid) - ! filename is trimmed by passage to open_block_file + "len=*" there. - filename = block_file_name('grid', -1, nb-1) - ncid = open_block_file(filename, 'read') + deallocate(temp) -! Read 3D array and extract the longitudes of the non-halo data of this block. -! The restart files have C-indexing (fastest changing dim is the last), -! So invert the dimension bounds. - call nc_get_variable(ncid, 'Longitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - context=routine, & - nc_count=(/zcount,ycount,xcount/)) + ! convert from radians into degrees + lons = lons * RAD2DEG + lats = lats * RAD2DEG - offset = (nxPerBlock * (nb - 1)) - lons(offset+1:offset+nxPerBlock) = temp(1,1,1:nxPerBlock) + if (debug > 4) then + print *, routine, 'All lons ', lons + print *, routine, 'All lats ', lats + print *, routine, 'All levs ', levs + endif - call nc_close_file(ncid) -enddo + if ( debug > 1 ) then ! Check dimension limits + write(error_string_1,*)'LON range ',minval(lons),maxval(lons) + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*)'LAT range ',minval(lats),maxval(lats) + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*)'ALT range ',minval(levs),maxval(levs) + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif -! go up west-most block row picking up all latitudes -do nb = 1, nBlocksLat +end subroutine get_grid_from_blocks - ! TODO; Aether block name counters start with 0, but the lat values can come from - ! any lon=const column. - nboff = ((nb - 1) * nBlocksLon) - filename = block_file_name('grid', -1, nboff) - ncid = open_block_file(filename, 'read') +!================================================================== - call nc_get_variable(ncid, 'Latitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - context=routine, nc_count=(/zcount,ycount,xcount/)) - +function read_aether_time(filename) +type(time_type) :: read_aether_time +character(len=*), intent(in) :: filename - offset = (nyPerBlock * (nb - 1)) - lats(offset+1:offset+nyPerBlock) = temp(1,1:nyPerBlock,1) +integer :: ncid +integer :: tsimulation ! the time read from a restart file; seconds from aether_ref_date. +integer :: ndays,nsecs - call nc_close_file(ncid) -enddo +character(len=*), parameter :: routine = 'read_aether_time' +tsimulation = MISSING_I -filename = block_file_name('grid', -1, 0) ncid = open_block_file(filename, 'read') +call nc_get_variable(ncid, 'time', tsimulation, context=routine) +call nc_close_file(ncid, routine, filename) -temp = MISSING_R8 -call nc_get_variable(ncid, 'Altitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - context=routine, nc_count=(/zcount,ycount,xcount/)) - -alts(1:nzPerBlock) = temp(1:nzPerBlock,1,1) - -call nc_close_file(ncid) - -deallocate(temp) - -! convert from radians into degrees -lons = lons * RAD2DEG -lats = lats * RAD2DEG +! Calculate the DART time of the file time. +! TODO: review calculation of ndays in read_aether_time +ndays = tsimulation/86400 +nsecs = tsimulation - ndays*86400 +! Need to subtract 1 because the ref day is not finished. +! NO, that was accounted for in the integer calculation of ndays. +! ndays = aether_ref_ndays -1 + ndays +ndays = aether_ref_ndays + ndays +read_aether_time = set_time(nsecs,ndays) -if (debug > 4) then - print *, 'All lons ', lons - print *, 'All lats ', lats - print *, 'All alts ', alts -endif +if (do_output()) & + call print_time(read_aether_time,routine//': time in restart file '//filename) +if (do_output()) & + call print_date(read_aether_time,routine//': date in restart file '//filename) -if ( debug > 1 ) then ! Check dimension limits - write(string1,*)'LON range ',minval(lons),maxval(lons) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'LAT range ',minval(lats),maxval(lats) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,*)'ALT range ',minval(alts),maxval(alts) - call error_handler(E_MSG,routine,string1,source,revision,revdate) +if (debug > 8) then + write(error_string_1,*)'tsimulation ',tsimulation + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*)'ndays ',ndays + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*)'nsecs ',nsecs + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + + call print_date(aether_ref_time, routine//':model base date') + call print_time(aether_ref_time, routine//':model base time') endif -end subroutine get_grid_from_blocks +end function read_aether_time !================================================================== -!> open the requested restart file and return the ncid - -function open_block_file(filename,rw) - -! filename is trimmed by this definition -character(len=*), intent(in) :: filename -character(len=*), intent(in) :: rw ! 'read' or 'readwrite' -integer :: open_block_file - -character(len=*), parameter :: routine = 'open_block_file' +function aether_name_to_dart(varname) -if ( .not. file_exist(filename) ) then - write(string1,*) 'cannot open file ', filename,' for ',rw - call error_handler(E_ERR,routine,string1,source,revision,revdate) -endif - -if (debug > 0) then - write(string1,*) 'Opening file ', trim(filename), ' for ', rw - call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) -end if - - -if (rw == 'read') then - open_block_file = nc_open_file_readonly(filename, routine) -else if (rw == 'readwrite') then - open_block_file = nc_open_file_readwrite(filename, routine) -else - string1 = ': must be called with rw={read,readwrite}, not '//rw - call error_handler(E_ERR,'open_block_file',string1,source,revision,revdate) -endif + character(len=vtablenamelength), intent(in) :: varname + + character(len=vtablenamelength) :: aether_name_to_dart, aether + character(len=64) :: parts(8), var_root + integer :: char_num, first, i_parts, aether_len, end_str + + aether = trim(varname) + aether_len = len_trim(varname) + parts = '' + + ! Look for the last ' '. The characters after that are the species. + ! If there's no ' ', the whole string is the species. + char_num = 0 + char_num = scan(trim(aether),' ',back=.true.) + var_root = aether(char_num+1:aether_len) + ! purge_chars removes unwanted [()\] + parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) + print*,'var_root, parts(1) = ',var_root, parts(1) + end_str = char_num + + ! Tranform remaining pieces of varname into DART versions. + char_num = MISSING_I + first = 1 + i_parts = 2 + do + ! This returns the position of the first blank *within the substring* passed in. + char_num = scan(aether(first:end_str),' ',back=.false.) + if (char_num > 0 .and. first < aether_len) then + parts(i_parts) = purge_chars(aether(first:first+char_num-1), '.)(\', plus_minus=.true.) + + first = first + char_num + i_parts = i_parts + 1 + else + exit + endif + enddo + + ! Construct the DART field name from the parts + aether_name_to_dart = trim(parts(1)) + i_parts = 2 + do + if (trim(parts(i_parts)) /= '') then + aether_name_to_dart = trim(aether_name_to_dart)//'_'//trim(parts(i_parts)) + i_parts = i_parts + 1 + else + exit + endif + enddo + +end function aether_name_to_dart + +!----------------------------------------------------------------- +! Replace undesirable characters with better. + +function purge_chars(ugly_string, chars, plus_minus) + + character (len=*), intent(in) :: ugly_string, chars + logical, intent(in) :: plus_minus + character (len=64) :: purge_chars + character (len=256) :: temp_str + + integer :: char_num, end_str, pm_num + + ! Trim is not needed here + temp_str = ugly_string + end_str = len_trim(temp_str) + char_num = MISSING_I + do + ! Returns 0 if chars are not found + char_num = scan(temp_str,chars) + ! Need to change it to a char that won't be found by scan in the next iteration, + ! and can be easily removed. + if (char_num > 0) then + ! Squeeze out the character + temp_str(char_num:end_str-1) = temp_str(char_num+1:end_str) + temp_str(end_str:end_str) = '' + ! temp_str(char_num:char_num) = ' ' + else + exit + endif + enddo + + ! Replace + and - with pos and neg. Assume there's only 1. + temp_str = trim(adjustl(temp_str)) + end_str = len_trim(temp_str) + pm_num = scan(trim(temp_str),'+-',back=.false.) + if (pm_num == 0 .or. .not. plus_minus) then + purge_chars = trim(temp_str) + else + if (temp_str(pm_num:pm_num) == '+') then + purge_chars = temp_str(1:pm_num-1)//'pos' + else if (temp_str(pm_num:pm_num) == '-') then + purge_chars = temp_str(1:pm_num-1)//'neg' + endif + if (pm_num+1 <= end_str) & + purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) + endif + +end function purge_chars +!--------------------------------------------------------------------------------------- -if (debug > 80) then - write(string1,*) 'Returned file descriptor is ', open_block_file - call error_handler(E_MSG,'open_block_file',string1,source,revision,revdate) -end if +function open_block_file(filename,rw) + ! filename is trimmed by this definition + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: rw ! 'read' or 'readwrite' + integer :: open_block_file + + character(len=*), parameter :: routine = 'open_block_file' + + if ( .not. file_exist(filename) ) then + write(error_string_1,*) 'cannot open file ', filename,' for ',rw + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + endif + + if (debug > 0) then + write(error_string_1,*) 'Opening file ', trim(filename), ' for ', rw + call error_handler(E_MSG,'open_block_file',error_string_1,source,revision,revdate) + end if + + + if (rw == 'read') then + open_block_file = nc_open_file_readonly(filename, routine) + else if (rw == 'readwrite') then + open_block_file = nc_open_file_readwrite(filename, routine) + else + error_string_1 = ': must be called with rw={read,readwrite}, not '//rw + call error_handler(E_ERR,'open_block_file',error_string_1,source,revision,revdate) + endif + + + if (debug > 80) then + write(error_string_1,*) 'Returned file descriptor is ', open_block_file + call error_handler(E_MSG,'open_block_file',error_string_1,source,revision,revdate) + end if + end function open_block_file -!================================================================= -! -! subroutine add_nc_definitions(ncid) -! -! integer, intent(in) :: ncid -! -! call nc_add_global_attribute(ncid, 'model', 'aether') -! -! !------------------------------------------------------------------------------- -! ! Determine shape of most important namelist -! !------------------------------------------------------------------------------- -! ! -! !call find_textfile_dims('gitm_vars.nml', nlines, linelen) -! !if (nlines > 0) then -! ! has_gitm_namelist = .true. -! ! -! ! allocate(textblock(nlines)) -! ! textblock = '' -! ! -! ! call nc_define_dimension(ncid, 'nlines', nlines) -! ! call nc_define_dimension(ncid, 'linelen', linelen) -! ! call nc_define_character_variable(ncid, 'gitm_in', (/ 'nlines ', 'linelen' /)) -! ! call nc_add_attribute_to_variable(ncid, 'gitm_in', 'long_name', 'contents of gitm_in namelist') -! ! -! !else -! ! has_gitm_namelist = .false. -! !endif -! ! -! !---------------------------------------------------------------------------- -! ! output only grid info - state vars will be written by other non-model_mod code -! !---------------------------------------------------------------------------- -! -! call nc_define_dimension(ncid, LON_DIM_NAME, nlon) -! call nc_define_dimension(ncid, LAT_DIM_NAME, nlat) -! call nc_define_dimension(ncid, ALT_DIM_NAME, nalt) -! ! TODO: is WL in Aether? No; remove from model_mod. -! call nc_define_dimension(ncid, 'WL', 1) ! wavelengths - currently only 1? -! -! !---------------------------------------------------------------------------- -! ! Create the (empty) Coordinate Variables and the Attributes -! !---------------------------------------------------------------------------- -! -! ! TODO: This defines more attributes than TIEGCM. Prefer? Are these accurate for Aether? -! ! Grid Longitudes -! call nc_define_double_variable(ncid, LON_VAR_NAME, (/ LON_DIM_NAME /) ) -! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'type', 'x1d') -! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'long_name', 'grid longitudes') -! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'cartesian_axis', 'X') -! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'units', 'degrees_east') -! call nc_add_attribute_to_variable(ncid, LON_VAR_NAME, 'valid_range', (/ 0.0_r8, 360.0_r8 /) ) -! -! ! Grid Latitudes -! call nc_define_double_variable(ncid, LAT_VAR_NAME, (/ LAT_DIM_NAME /) ) -! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'type', 'y1d') -! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'long_name', 'grid latitudes') -! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'cartesian_axis', 'Y') -! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'units', 'degrees_north') -! call nc_add_attribute_to_variable(ncid, LAT_VAR_NAME, 'valid_range', (/ -90.0_r8, 90.0_r8 /) ) -! -! ! Grid Altitudes -! call nc_define_double_variable(ncid, ALT_VAR_NAME, (/ ALT_DIM_NAME /) ) -! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'type', 'z1d') -! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'long_name', 'grid altitudes') -! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'cartesian_axis', 'Z') -! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'units', 'meters') -! call nc_add_attribute_to_variable(ncid, ALT_VAR_NAME, 'positive', 'up') -! -! ! Grid wavelengths -! call nc_define_double_variable(ncid, 'WL', (/ 'WL' /) ) -! call nc_add_attribute_to_variable(ncid, 'WL', 'type', 'x1d') -! call nc_add_attribute_to_variable(ncid, 'WL', 'long_name', 'grid wavelengths') -! call nc_add_attribute_to_variable(ncid, 'WL', 'cartesian_axis', 'X') -! call nc_add_attribute_to_variable(ncid, 'WL', 'units', 'wavelength_index') -! call nc_add_attribute_to_variable(ncid, 'WL', 'valid_range', (/ 0.9_r8, 38.1_r8 /) ) -! -! end subroutine add_nc_definitions -! !================================================================= ! open all restart files and transfer the requested data item ! to the filter input file. subroutine restarts_to_filter(dirname, ncid_output, member, define) -character(len=*), intent(in) :: dirname -integer, intent(in) :: ncid_output, member -logical, intent(in) :: define - -integer :: ibLoop, jbLoop -integer :: ib, jb - -if (define) then - ! if define, run one block. - ! the block_to_filter_io call defines the variables in the whole domain netCDF file. - ibLoop = 1 - jbLoop = 1 - call nc_begin_define_mode(ncid_output) -else - ! if not define, run all blocks. - ! the block_to_filter_io call adds the (ib,jb) block to a netCDF variable - ! in order to make a file containing the data for all the blocks. - ibLoop = nBlocksLon - jbLoop = nBlocksLat -end if - -do jb = 1, jbLoop - do ib = 1, ibLoop - - call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) + character(len=*), intent(in) :: dirname + integer, intent(in) :: ncid_output, member + logical, intent(in) :: define + + integer :: ibLoop, jbLoop + integer :: ib, jb, nb, iunit + + character(len=256) :: filter_io_filename + + + if (define) then + ! if define, run one block. + ! the block_to_filter_io call defines the variables in the whole domain netCDF file. + ibLoop = 1 + jbLoop = 1 + ! nc_write_model_atts puts it in define, and takes it out. + call nc_begin_define_mode(ncid_output) + else + ! if not define, and run all blocks. + ! the block_to_filter_io call adds the (ib,jb) block to a netCDF variable + ! in order to make a file containing the data for all the blocks. + ibLoop = nblocks_lon + jbLoop = nblocks_lat + end if + + do jb = 1, jbLoop + do ib = 1, ibLoop + + call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) + + enddo + enddo + + if (define) then + call nc_end_define_mode(ncid_output) + endif + +end subroutine restarts_to_filter - enddo -enddo +!========================================================================= -if (define) call nc_end_define_mode(ncid_output) +function read_in_real(iunit,varname,filter_io_filename) -end subroutine restarts_to_filter + integer, intent(in) :: iunit + character(len=*), intent(in) :: varname,filter_io_filename + real(r8) :: read_in_real + + character(len=100) :: cLine + integer :: i, ios + + ! Read a line + read(iunit,'(a)',iostat=ios) cLine + if (ios /= 0) then + write(error_string_1,*) 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR,'get_grid_dims',error_string_1,source,revision,revdate) + endif + + ! Remove anything after a space or TAB + i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' + i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' + + ! Now that we have a line with nothing else ... parse it + read(cLine,*,iostat=ios)read_in_real + + if(ios /= 0) then + write(error_string_1,*)'unable to read '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR,'read_in_real',error_string_1,source,revision,revdate) + endif + +end function read_in_real -!================================================================== +!-------------------------------------------------------------------- + +function read_in_int(iunit,varname,filter_io_filename) + + integer, intent(in) :: iunit + character(len=*), intent(in) :: varname,filter_io_filename + integer :: read_in_int + + character(len=100) :: cLine + integer :: i, ios + + ! Read a line + read(iunit,'(a)',iostat=ios) cLine + if (ios /= 0) then + write(error_string_1,*) 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR,'get_grid_dims',error_string_1,source,revision,revdate) + endif + + ! Remove anything after a space or TAB + i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' + i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' + + read(cLine,*,iostat=ios)read_in_int + + if(ios /= 0) then + write(error_string_1,*)'unable to read '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR,'read_in_int',error_string_1,source,revision,revdate,& + text2=cLine) + endif + +end function read_in_int +!-------------------------------------------------------------------- !> Open all restart files for a block and read in the requested data items. !> The write_filter_io calls will write the data to the filter_input.nc. !> @@ -1977,1164 +1672,624 @@ end subroutine restarts_to_filter !> in the filter_input.nc (define = .true.), !> then run again to write the data to the NC file(define = .false.) -subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) +subroutine write_filter_io(data3d, varname, block, ncid) -integer, intent(in) :: ncid_output -character(len=*), intent(in) :: dirname -integer, intent(in) :: ib, jb -integer, intent(in) :: member -logical, intent(in) :: define - -real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) -real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) -real(r4) :: temp0d !Alex: single parameter has "zero dimensions" TODO f107? -integer :: i, j, ivar, nb, ncid_input !i,j, maybe for TEC calc -integer :: block(2) = 0 - -logical :: no_idensity - -character(len=*), parameter :: routine = 'block_to_filter_io' -character(len=128) :: file_root -character(len=256) :: filename -character(len=NF90_MAX_NAME) :: varname, dart_varname - -block(1) = ib -block(2) = jb -! The block number, as counted in Aether. -! Lower left is 0, increase to the East, then 1 row farther north, West to East. -nb = (jb-1) * nBlocksLon + ib - 1 - -! treat alt specially since we want to derive TEC here -! TODO: See density_ion_e too. -allocate( alt1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) - -! temp array large enough to hold any 2D field -allocate(temp2d(1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost)) - -! TODO: We need all altitudes, but there might be vertical blocks in the future. -! But there would be no vertical halos. -! Make nzcount adapt to whether there are blocks. -! And temp needs to have C-ordering, which is what the restart files have. -! temp array large enough to hold 1 species, temperature, etc -allocate(temp3d(1:nzPerBlock, & - 1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost)) - -! save density_ion_e to compute TEC -allocate(density_ion_e(1:nzPerBlock, & - 1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost)) - - - -! TODO; Does Aether need a replacement for these Density fields? Yes. -! But they are probably read by the loops below. -! Don't need to fetch index because Aether has NetCDF restarts, -! so just loop over the field names to read. -! call get_index_from_gitm_varname('IDensityS', inum, ivals) -! -! ! assume we could not find the electron density for VTEC calculations -! no_idensity = .true. -! -! if (inum > 0) then -! ! one or more items in the state vector need to replace the -! ! data in the output file. loop over the index list in order. -! j = 1 -! ! TODO: electron density is not in the restart files, but it's needed for TEC -! In Aether they will be from an ions file, but now only from an output file (2023-10-30). -! do i = 1, nIons -! if (debug > 80) then -! write(string1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & -! ' for block (',ib,',',jb,')' -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! read(iunit) temp3d -! if (j <= inum) then -! if (i == gitmvar(ivals(j))%gitm_index) then -! ! ie_, the gitm index for electron density, comes from ModEarth -! if (gitmvar(ivals(j))%gitm_index == ie_) then -! ! save the electron density for TEC computation -! density_ion_e(:,:,:) = temp3d(:,:,:) -! no_idensity = .false. -! end if -! ! read from input but write from state vector -! call write_filter_io(temp3d, ivals(j), block, ncid) -! j = j + 1 -! endif -! endif -! enddo -! else -! ! nothing at all from this variable in the state vector. -! ! read past this variable -! if (debug > 80) then -! write(string1,'(A)') 'Not writing the IDensityS variables to file' -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! do i = 1, nIons -! read(iunit) temp3d -! enddo -! endif - -! Handle the 2 restart file types (ions and neutrals). -! Each field has a file type associated with it: variable_table(f_index,VT_ORIGININDX) -! TODO: for now require that all neutrals are listed in variable_table before the ions. - -file_root = variable_table(1,VT_ORIGININDX) -filename = block_file_name(file_root, member, nb) -ncid_input = open_block_file(filename, 'read') - -do ivar = 1, nfields_neutral -! TODO: the nf90 functions cannot read the variable names with the '\'s in them. -! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) - varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) -! TODO: Convert print to the error handler with conditional - if ( debug > 0 ) then - write(string1,'("varname = ",A)') varname - call error_handler(E_MSG,routine,string1,source,revision,revdate) - endif -! NEWIC; -! Translate the Aether field name into a DART field name. - dart_varname = aeth_name_to_dart(varname) - - ! TODO: Given the subroutine name, perhaps these definition sections should be - ! one call higher up, with the same loop around it. - if (define) then - ! Define the variable in the filter_input.nc file (the output from this program). - ! The calling routine entered define mode. - - if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',dart_varname - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if + real(r4), intent(in) :: data3d(1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost, & + 1) - call nc_define_real_variable(ncid_output, dart_varname, & - (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) - if ( debug > 0 ) then - write(string1,'("defined ivar, dart_varname = ",i5,1x,A)') ivar, trim(dart_varname) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - endif -! TODO: does the filter_input.nc file need all these attributes? TIEGCM doesn't add them. - ! They are not available from the restart files. - ! Add them to the ions section too. - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'long_name', gitmvar(ivar)%long_name) - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'units', gitmvar(ivar)%units) - ! !call nc_add_attribute_to_variable(ncid, dart_varname, 'storder', gitmvar(ivar)%storder) - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_index', gitmvar(ivar)%gitm_index) - - - else if (file_root == 'neutrals') then - ! Read 3D array and extract the non-halo data of this block. -! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. - call nc_get_variable(ncid_input, varname, temp3d, context=routine) -! TODO: Convert print to the error handler with conditional - if ( debug > 0 ) then - write(string1,'(3A,L,A,1p2e13.5)') 'varname = ',trim(varname), ', define = ',define, & - ', temp3d = ',temp3d(1,1,1),temp3d(15,15,15) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - endif - - call write_filter_io(temp3d, dart_varname, block, ncid_output) - else - write(string1,*) 'Trying to read neutrals, but variable_table(',ivar,VT_ORIGININDX, & - ') /= "neutrals"' - call error_handler(E_ERR,routine,string1,source,revision,revdate) - endif - -enddo -call nc_close_file(ncid_input) - -file_root = variable_table(nfields_neutral+1,VT_ORIGININDX) -filename = block_file_name(file_root, member, nb) -ncid_input = open_block_file(filename, 'read') + character(len=vtablenamelength), intent(in) :: varname + integer, intent(in) :: block(2) + integer, intent(in) :: ncid + + integer :: ib, jb + integer :: starts(4) + character(len=*), parameter :: routine = 'write_filter_io' + + + ! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) + + ib = block(1) + jb = block(2) + + ! to compute the start, consider (ib-1)*nx_per_block+1 + starts(1) = 1 + starts(2) = (jb-1)*ny_per_block+1 + starts(3) = (ib-1)*nx_per_block+1 + starts(4) = 1 + ! TODO: convert to error_msg + ! print*,routine,'; starts = ',starts + ! print*,routine,'; counts = ',nz_per_block,ny_per_block,nx_per_block,1 + +! data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & + call nc_put_variable(ncid, varname, & + data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block,1), & + context=routine, nc_start=starts, & + nc_count=(/nz_per_block,ny_per_block,nx_per_block,1/)) + ! TODO: convert to error_msg + ! print*,routine,': filled varname = ', varname + +end subroutine write_filter_io -do ivar = nfields_neutral +1,nfields_neutral + nfields_ion -! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) - varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) -! NEWIC; -! Translate the Aether field name into a DART field name. - dart_varname = aeth_name_to_dart(varname) +!-------------------------------------------------------------------- - if (define) then +subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) - if (debug > 10) then - write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',dart_varname - call error_handler(E_MSG,routine,string1,source,revision,revdate) - end if + integer, intent(in) :: ncid_output + character(len=*), intent(in) :: dirname + integer, intent(in) :: ib, jb + integer, intent(in) :: member + logical, intent(in) :: define + + real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:,:) + real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) + real(r4) :: temp0d !Alex: single parameter has "zero dimensions" + integer :: i, j, maxsize, ivar, nb, ncid_input + integer :: block(2) = 0 + + logical :: no_idensity - call nc_define_real_variable(ncid_output, dart_varname, & - (/ ALT_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME /) ) - if ( debug > 0 ) then - write(string1,'("defined ivar, dart_varname = ",i5,2x,A)') ivar, trim(dart_varname) - call error_handler(E_MSG,routine,string1,source,revision,revdate) + character(len=*), parameter :: routine = 'block_to_filter_io' + character(len=128) :: file_root + character(len=256) :: filename + character(len=vtablenamelength) :: varname, dart_varname + + block(1) = ib + block(2) = jb + ! The block number, as counted in Aether. + ! Lower left is 0, increase to the East, then 1 row farther north, West to East. + nb = (jb-1) * nblocks_lon + ib - 1 + + ! a temp array large enough to hold any of the + ! Lon,Lat or Alt array from a block plus ghost cells + allocate(temp1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) + + ! treat alt specially since we want to derive TEC here + ! TODO: See density_ion_e too. + allocate( alt1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) + + ! temp array large enough to hold any 2D field + allocate(temp2d(1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) + + ! TODO: We need all altitudes, but there might be vertical blocks in the future. + ! But there would be no vertical halos. + ! Make nzcount adapt to whether there are blocks. + ! And temp needs to have C-ordering, which is what the restart files have. + ! temp array large enough to hold 1 species, temperature, etc + allocate(temp3d(1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost, & + 1)) + + ! save density_ion_e to compute TEC + allocate(density_ion_e(1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) + + ! Aether gives a unique name to each (of 6) velocity components + ! ! temp array large enough to hold velocity vect, etc + ! maxsize = max(3, nSpecies) + ! allocate(temp4d(1-nghost:nx_per_block+nghost, & + ! 1-nghost:ny_per_block+nghost, & + ! 1-nghost:nz_per_block+nghost, maxsize)) + + + ! TODO; Does Aether need a replacement for these Density fields? Yes. + ! But they are probably read by the loops below. + ! Don't need to fetch index because Aether has NetCDF restarts, + ! so just loop over the field names to read. + ! Read the index from the first species + ! call get_index_from_gitm_varname('NDensityS', inum, ivals) + + ! if (inum > 0) then + ! ! if i equals ival, use the data from the state vect + ! ! otherwise read/write what's in the input file + ! j = 1 + ! do i = 1, nSpeciesTotal + ! if (debug > 80) then + ! write(error_string_1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading species ',i,' of ',nSpeciesTotal, & + ! ' for block (',ib,',',jb,')' + ! call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + ! end if + ! read(iunit) temp3d + ! if (j <= inum) then + ! if (i == gitmvar(ivals(j))%gitm_index) then + ! call write_filter_io(temp3d, ivals(j), block, ncid) + ! j = j + 1 + ! endif + ! endif + ! enddo + ! else + ! if (debug > 80) then + ! write(error_string_1,'(A)') 'Not writing the NDensityS variables to file' + ! call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + ! end if + ! ! nothing at all from this variable in the state vector. + ! ! copy all data over from the input file to output file + ! do i = 1, nSpeciesTotal + ! read(iunit) temp3d + ! enddo + ! endif + ! + ! call get_index_from_gitm_varname('IDensityS', inum, ivals) + ! + ! ! assume we could not find the electron density for VTEC calculations + ! no_idensity = .true. + ! + ! if (inum > 0) then + ! ! one or more items in the state vector need to replace the + ! ! data in the output file. loop over the index list in order. + ! j = 1 + ! ! TODO: electron density is not in the restart files, but it's needed for TEC + ! In Aether they will be from an ions file, but now only from an output file (2023-10-30). + ! do i = 1, nIons + ! if (debug > 80) then + ! write(error_string_1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & + ! ' for block (',ib,',',jb,')' + ! call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + ! end if + ! read(iunit) temp3d + ! if (j <= inum) then + ! if (i == gitmvar(ivals(j))%gitm_index) then + ! ! ie_, the gitm index for electron density, comes from ModEarth + ! if (gitmvar(ivals(j))%gitm_index == ie_) then + ! ! save the electron density for TEC computation + ! density_ion_e(:,:,:) = temp3d(:,:,:) + ! no_idensity = .false. + ! end if + ! ! read from input but write from state vector + ! call write_filter_io(temp3d, ivals(j), block, ncid) + ! j = j + 1 + ! endif + ! endif + ! enddo + ! else + ! ! nothing at all from this variable in the state vector. + ! ! read past this variable + ! if (debug > 80) then + ! write(error_string_1,'(A)') 'Not writing the IDensityS variables to file' + ! call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + ! end if + ! do i = 1, nIons + ! read(iunit) temp3d + ! enddo + ! endif + + ! Handle the 2 restart file types (ions and neutrals). + ! Each field has a file type associated with it: variables(VT_ORIGININDX,f_index) + ! TODO: for now require that all neutrals are listed in variables before the ions. + + file_root = variables(VT_ORIGININDX,1) + filename = block_file_name(file_root, member, nb) + ncid_input = open_block_file(filename, 'read') + + if (debug >= 100 .and. do_output()) print*,'block_to_filter_io: nvar_neutral = ',nvar_neutral + do ivar = 1, nvar_neutral + ! TODO: the nf90 functions cannot read the variable names with the '\'s in them. + ! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + if (debug >= 100 .and. do_output()) print*,routine,'varname = ',varname + ! Translate the Aether field name into a DART field name. + dart_varname = aether_name_to_dart(varname) + + ! TODO: Given the subroutine name, perhaps these definition sections should be + ! one call higher up, with the same loop around it. + if (define) then + ! Define the variable in the filter_input.nc file (the output from this program). + ! The calling routine entered define mode. + + if (debug > 10 .and. do_output()) then + write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',dart_varname + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + end if + + call nc_define_real_variable(ncid_output, dart_varname, & + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME, TIME_DIM_NAME /) ) + ! TODO: does the filter_input.nc file need all these attributes? TIEGCM doesn't add them. + ! They are not available from the restart files. + ! Add them to the ions section too. + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'long_name', gitmvar(ivar)%long_name) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'units', gitmvar(ivar)%units) + ! !call nc_add_attribute_to_variable(ncid, dart_varname, 'storder', gitmvar(ivar)%storder) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) + ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_index', gitmvar(ivar)%gitm_index) + + + else if (file_root == 'neutrals') then + ! Read 3D array and extract the non-halo data of this block. + ! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. + call nc_get_variable(ncid_input, varname, temp3d, context=routine) + if (debug >= 100 .and. do_output()) then + ! TODO convert to error_handler? + print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1,1),temp3d(15,15,15,1),varname + print*,'block_to_filter_io: define = ',define + endif + call write_filter_io(temp3d, dart_varname, block, ncid_output) + else + write(error_string_1,*) 'Trying to read neutrals, but variables(',VT_ORIGININDX,ivar , & + ') /= "neutrals"' + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) endif + + enddo + call nc_close_file(ncid_input) + + file_root = variables(VT_ORIGININDX,nvar_neutral+1) + filename = block_file_name(file_root, member, nb) + ncid_input = open_block_file(filename, 'read') + + print*,'block_to_filter_io: nvar_ion = ',nvar_ion + do ivar = nvar_neutral +1,nvar_neutral + nvar_ion + ! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) +! print*,'Purging \ from aether name' + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + ! NEWIC; + ! Translate the Aether field name into a DART field name. +! print*,'Converting aether name ',trim(varname) + dart_varname = aether_name_to_dart(varname) + + if (define) then + + if (debug > 10 .and. do_output()) then + write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',dart_varname + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + end if + + call nc_define_real_variable(ncid_output, dart_varname, & + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME, TIME_DIM_NAME /) ) + print*,routine,': defined ivar, dart_varname = ', ivar, dart_varname + + else if (file_root == 'ions') then + call nc_get_variable(ncid_input, varname, temp3d, context=routine) + call write_filter_io(temp3d, dart_varname, block, ncid_output) + else + write(error_string_1,*) 'Trying to read ions, but variables(',VT_ORIGININDX,ivar , & + ') /= "ions"' + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + endif + + enddo - else if (file_root == 'ions') then - call nc_get_variable(ncid_input, varname, temp3d, context=routine) - call write_filter_io(temp3d, dart_varname, block, ncid_output) - else - write(string1,*) 'Trying to read ions, but variable_table(',ivar,VT_ORIGININDX, & - ') /= "ions"' - call error_handler(E_ERR,routine,string1,source,revision,revdate) - endif - -enddo -call nc_close_file(ncid_input) - -! TODO: Does Aether need TEC to be calculated? Yes -! ! add the VTEC as an extended-state variable -! ! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program -! call get_index_from_gitm_varname('TEC', inum, ivals) -! -! if (inum > 0 .and. no_idensity) then -! write(string1,*) 'Cannot compute the VTEC without the electron density' -! call error_handler(E_ERR,routine,string1,source,revision,revdate) -! end if -! -! if (inum > 0) then -! if (.not. define) then -! temp2d = 0._r8 -! ! comptue the TEC integral -! do i =1,nzPerBlock-1 ! approximate the integral over the altitude as a sum of trapezoids -! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 -! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 -! end do -! ! convert temp2d to TEC units -! temp2d = temp2d/1e16_r8 -! end if -! call write_block_to_filter2d(temp2d, ivals(1), block, ncid, define) -! end if - -! TODO: Does Aether need f10_7 to be calculated or processed? Yes -! read(iunit) temp0d -! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') -! call get_index_from_gitm_varname('f107', inum, ivals) -! if (inum > 0) then -! call write_block_to_filter0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine -! endif -! -! read(iunit) temp3d -! call get_index_from_gitm_varname('Rho', inum, ivals) -! if (inum > 0) then -! call write_block_to_filter(temp3d, ivals(1), block, ncid, define) -! endif - -!print *, 'calling dealloc' -deallocate(temp2d, temp3d) -deallocate(alt1d, density_ion_e) - + ! Leave file open if fields were just added (define = .false.), + ! so that time can be added. + if (define) call nc_close_file(ncid_input) + + ! TODO: Does Aether need TEC to be calculated? Yes + ! ! add the VTEC as an extended-state variable + ! ! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program + ! call get_index_from_gitm_varname('TEC', inum, ivals) + ! + ! if (inum > 0 .and. no_idensity) then + ! write(error_string_1,*) 'Cannot compute the VTEC without the electron density' + ! call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + ! end if + ! + ! if (inum > 0) then + ! if (.not. define) then + ! temp2d = 0._r8 + ! ! comptue the TEC integral + ! do i =1,nz_per_block-1 ! approximate the integral over the altitude as a sum of trapezoids + ! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 + ! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 + ! end do + ! ! convert temp2d to TEC units + ! temp2d = temp2d/1e16_r8 + ! end if + ! call write_block_to_filter2d(temp2d, ivals(1), block, ncid, define) + ! end if + + ! TODO: Does Aether need f10_7 to be calculated or processed? Yes + ! read(iunit) temp0d + ! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') + ! call get_index_from_gitm_varname('f107', inum, ivals) + ! if (inum > 0) then + ! call write_block_to_filter0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine + ! endif + ! + ! read(iunit) temp3d + ! call get_index_from_gitm_varname('Rho', inum, ivals) + ! if (inum > 0) then + ! call write_block_to_filter(temp3d, ivals(1), block, ncid, define) + ! endif + + !print *, 'calling dealloc' + deallocate(temp1d, temp2d, temp3d) + deallocate(alt1d, density_ion_e) + end subroutine block_to_filter_io -!================================================================== - -!> TODO: Activate f10_7 code? -! !> put the f107 estimate (a scalar, hence 0d) into the state vector. -! !> Written specifically -! !> for f107 since f107 is the same for all blocks. So what it does -! !> is take f107 from the first block (block = 0) and disregard -! !> f107 values from all other blocks (hopefully they are the same). -! !> written by alex -! -! subroutine write_block_to_filter0d(data0d, ivar, ncid, define) -! -! real(r8), intent(in) :: data0d -! integer, intent(in) :: ivar ! index into state structure -! integer, intent(in) :: ncid -! logical, intent(in) :: define -! -! -! character(len=*), parameter :: routine = 'write_block_to_filter0d' -! -! if (define) then -! -! if (debug > 10) then -! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! -! call nc_define_double_scalar(ncid, gitmvar(ivar)%varname) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) -! -! else -! -! call nc_put_variable(ncid, gitmvar(ivar)%varname, data0d, context=routine) -! -! end if -! -! end subroutine write_block_to_filter0d -! -! !================================================================== -! -! ! put the requested data into a netcdf variable -! -! subroutine write_block_to_filter2d(data2d, ivar, block, ncid, define) -! -! real(r8), intent(in) :: data2d(1-nGhost:nxPerBlock+nGhost, & -! 1-nGhost:nyPerBlock+nGhost) -! -! integer, intent(in) :: ivar ! variable index -! integer, intent(in) :: block(2) -! integer, intent(in) :: ncid -! logical, intent(in) :: define -! -! integer :: ib, jb -! integer :: starts(2) -! character(len=*), parameter :: routine = 'write_block_to_filter2d' -! -! if (define) then -! -! if (debug > 10) then -! write(string1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',trim(gitmvar(ivar)%varname) -! call error_handler(E_MSG,routine,string1,source,revision,revdate) -! end if -! -! call nc_define_double_variable(ncid, gitmvar(ivar)%varname, (/ LON_DIM_NAME, LAT_DIM_NAME /) ) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'long_name', gitmvar(ivar)%long_name) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'units', gitmvar(ivar)%units) -! !call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'storder', gitmvar(ivar)%storder) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) -! call nc_add_attribute_to_variable(ncid, gitmvar(ivar)%varname, 'gitm_index', gitmvar(ivar)%gitm_index) -! -! else -! ib = block(1) -! jb = block(2) -! -! ! to compute the start, consider (ib-1)*nxPerBlock+1 -! starts(1) = (ib-1)*nxPerBlock+1 -! starts(2) = (jb-1)*nyPerBlock+1 -! -! call nc_put_variable(ncid, gitmvar(ivar)%varname, & -! data2d(1:nxPerBlock,1:nyPerBlock), & -! context=routine, nc_start=starts, & -! nc_count=(/nxPerBlock,nyPerBlock/)) -! end if -! -! end subroutine write_block_to_filter2d - -!================================================================== - -! put the requested data into a netcdf variable - -subroutine write_filter_io(data3d, varname, block, ncid) - -real(r4), intent(in) :: data3d(1:nzPerBlock, & - 1-nGhost:nyPerBlock+nGhost, & - 1-nGhost:nxPerBlock+nGhost) - -character(len=NF90_MAX_NAME), intent(in) :: varname -integer, intent(in) :: block(2) -integer, intent(in) :: ncid - -integer :: ib, jb -integer :: starts(3) -character(len=*), parameter :: routine = 'write_filter_io' - - -! write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) - -ib = block(1) -jb = block(2) - -! to compute the start, consider (ib-1)*nxPerBlock+1 -starts(1) = 1 -starts(2) = (jb-1)*nyPerBlock+1 -starts(3) = (ib-1)*nxPerBlock+1 - -call nc_put_variable(ncid, varname, & - data3d(1:nzPerBlock,1:nyPerBlock,1:nxPerBlock), & - context=routine, nc_start=starts, & - nc_count=(/nzPerBlock,nyPerBlock,nxPerBlock/)) - -end subroutine write_filter_io - -!================================================================== -! Routines for dart_to_aether. -!================================================================== - -! open all restart files and write out the requested data item +!-------------------------------------------------------------------- subroutine filter_to_restarts(ncid, member) -integer, intent(in) :: member, ncid - -real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) -character(len=256) :: file_root -integer :: ivar - -character(len=NF90_MAX_NAME):: varname, dart_varname -character(len=*), parameter :: routine = 'filter_to_restarts' - -! Space for full domain field (read from filter_output.nc) -! and halo around the full domain -allocate(fulldom3d(1:nalt, & - 1-nGhost:nlat+nGhost, & - 1-nGhost:nlon+nGhost)) - -! get the dirname, construct the filenames inside open_block_file - -! >>> TODO: Not all fields have halos suitable for calculating gradients. -! These do (2023-11-8): neutral temperature, O, O2, N2, and the horizontal winds. -! The current model_mod will fill all neutral halos anyway, -! since that's simpler and won't break the model. -! TODO: add an attribute to the variable_table (?) to denote whether a field -! should have its halo filled. -do ivar = 1, nfields_neutral - varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) -! TODO: Convert print to the error handler with conditional - if ( debug > 0 ) then - write(string1,'("varname = ",A)') trim(varname) - call error_handler(E_MSG,routine,string1,source,revision,revdate) - endif -! NEWIC; -! Translate the Aether field name into a DART field name. - dart_varname = aeth_name_to_dart(varname) - - file_root = trim(variable_table(ivar,VT_ORIGININDX)) - if (file_root == 'neutrals') then - ! Assuming that this parameter is available through the `use netcdf` command. - fulldom3d = NF90_FILL_REAL - call nc_get_variable(ncid, dart_varname, fulldom3d(1:nalt,1:nlat,1:nlon), & - nc_count=(/nalt,nlat,nlon/),context=routine) - ! TODO: ncount not needed? Reading the whole field. - - ! Copy updated field values to full domain halo. - ! Block domains+halos will be easily read from this. - call add_halo_fulldom3d(fulldom3d) - - call filter_io_to_blocks(fulldom3d, varname, file_root, member) - else - ! TODO: error; varname is inconsistent with VT_ORIGININDX - endif - -enddo - -do ivar = nfields_neutral+1, nfields_neutral + nfields_ion - varname = purge_chars(trim(variable_table(ivar,VT_VARNAMEINDX)), '\', plus_minus=.false.) -! NEWIC; -! Translate the Aether field name into a DART field name. - dart_varname = aeth_name_to_dart(varname) - - file_root = trim(variable_table(ivar,VT_ORIGININDX)) -! TODO: Convert print to the error handler with conditional - if ( debug > 0 ) then - write(string1,'("varname, dart_varname, file_root = ",3(2x,A))') & - trim(varname), trim(dart_varname), file_root - call error_handler(E_MSG,routine,string1,source,revision,revdate) - endif - - if (file_root == 'ions') then - fulldom3d = NF90_FILL_REAL - call nc_get_variable(ncid, dart_varname, fulldom3d(1:nalt,1:nlat,1:nlon), & - nc_count=(/nalt,nlat,nlon/),context=routine) - !? ncount not needed? Reading the whole field. - - ! Copy updated field values to full domain halo. - ! Block domains+halos will be easily read from this. - ! 2023-11: ions do not have real or used data in their halos. - ! Make this clear by leaving the halos filled with MISSING_R4 - ! TODO: Will this be translated into NetCDF missing_value? - ! call add_halo_fulldom3d(fulldom3d) - - call filter_io_to_blocks(fulldom3d, varname, file_root, member) - - else - ! TODO: error; varname is inconsistent with VT_ORIGININDX - endif -enddo - -deallocate(fulldom3d) -!, fulldom1d - + integer, intent(in) :: member, ncid + + real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) + character(len=256) :: file_root + integer :: ivar + + character(len=vtablenamelength):: varname, dart_varname + character(len=*), parameter :: routine = 'filter_to_restarts' + + ! Space for full domain field (read from filter_output.nc) + ! and halo around the full domain + allocate(fulldom3d(1:nlev, & + 1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost)) + + ! get the dirname, construct the filenames inside open_block_file + + ! >>> TODO: Not all fields have halos suitable for calculating gradients. + ! These do (2023-11-8): neutral temperature, O, O2, N2, and the horizontal winds. + ! The current model_mod will fill all neutral halos anyway, + ! since that's simpler and won't break the model. + ! TODO: add an attribute to the variables (?) to denote whether a field + ! should have its halo filled. + do ivar = 1, nvar_neutral + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + if (debug >= 0 .and. do_output()) then + write(error_string_1,'("varname = ",A)') trim(varname) + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif + ! NEWIC; + ! Translate the Aether field name into a DART field name. + dart_varname = aether_name_to_dart(varname) + + file_root = trim(variables(VT_ORIGININDX,ivar)) + if (file_root == 'neutrals') then + ! Assuming that this parameter is available through the `use netcdf` command. + fulldom3d = NF90_FILL_REAL + + call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & + nc_count=(/nlev,nlat,nlon,1/),context=routine) + ! TODO: ncount not needed? Reading the whole field. + + ! Copy updated field values to full domain halo. + ! Block domains+halos will be easily read from this. + call add_halo_fulldom3d(fulldom3d) + + call filter_io_to_blocks(fulldom3d, varname, file_root, member) + else + ! TODO: error; varname is inconsistent with VT_ORIGININDX + endif + + enddo + + do ivar = nvar_neutral+1, nvar_neutral + nvar_ion + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + ! NEWIC; + ! Translate the Aether field name into a DART field name. + dart_varname = aether_name_to_dart(varname) + + file_root = trim(variables(VT_ORIGININDX,ivar)) + if (debug >= 0 .and. do_output()) then + write(error_string_1,'("varname, dart_varname, file_root = ",3(2x,A))') & + trim(varname), trim(dart_varname), file_root + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif + + if (file_root == 'ions') then + fulldom3d = NF90_FILL_REAL + call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & + nc_count=(/nlev,nlat,nlon,1/),context=routine) + !? ncount not needed? Reading the whole field. + + ! Copy updated field values to full domain halo. + ! Block domains+halos will be easily read from this. + ! 2023-11: ions do not have real or used data in their halos. + ! Make this clear by leaving the halos filled with MISSING_R4 + ! TODO: Will this be translated into NetCDF missing_value? + ! call add_halo_fulldom3d(fulldom3d) + + call filter_io_to_blocks(fulldom3d, varname, file_root, member) + + else + ! TODO: error; varname is inconsistent with VT_ORIGININDX + endif + enddo + + deallocate(fulldom3d) + !, fulldom1d + end subroutine filter_to_restarts -!================================================================== +!-------------------------------------------------------------------- subroutine add_halo_fulldom3d(fulldom3d) -! Space for full domain field (read from filter_output.nc) -! and halo around the full domain -real(r4), intent(inout) :: fulldom3d(1:nzPerBlock, & - 1-nGhost:nlat+nGhost, & - 1-nGhost:nlon+nGhost) - -character(len=*), parameter :: routine = 'add_halo_fulldom3d' -integer :: g, i,j, haflat,haflon -real(r4), allocatable :: normed(:,:) -character(len=16) :: debug_format - -! An array for debugging by renormalizing an altitude of fulldom3d. -allocate(normed(1-nGhost:nlat+nGhost, & - 1-nGhost:nlon+nGhost)) - -haflat = nlat/2 -haflon = nlon/2 - -do g = 1,nGhost - ! left; reach around the date line. - ! There's no data at the ends of the halos for this copy. - fulldom3d (:,1:nlat, 1-g) & - = fulldom3d(:,1:nlat,nlon+1-g) - - ! right - fulldom3d (:,1:nlat,nlon+g) & - = fulldom3d(:,1:nlat,g) - - ! bottom; reach over the S Pole for halo values. - ! There is data at the ends of the halos for these.) - - fulldom3d (:,1-g ,1-nGhost :haflon) & - = fulldom3d(:, g ,1-nGhost+haflon:nlon) - fulldom3d (:,1-g ,haflon+1:nlon) & - = fulldom3d(:, g ,1 :haflon) - ! Last 2 (halo) points on the right edge (at the bottom) - fulldom3d (:,1-g , nlon+1: nlon+nGhost) & - = fulldom3d(:, g ,haflon+1:haflon+nGhost) - - ! top - fulldom3d (:,nlat +g ,1-nGhost :haflon) & - = fulldom3d(:,nlat+1-g ,1-nGhost+haflon:nlon) - fulldom3d (:,nlat +g ,haflon+1:nlon) & - = fulldom3d(:,nlat+1-g ,1 :haflon) - ! Last 2 (halo) points on the right edge (at the top) - fulldom3d (:,nlat +g , nlon+1: nlon+nGhost) & - = fulldom3d(:,nlat+1-g ,haflon+1:haflon+nGhost) -enddo - -if (any(fulldom3d == MISSING_R4)) then - string1 = 'ERROR: some fulldom3d contain MISSING_R4 after halos' - call error_handler(E_ERR,routine,string1,source,revision,revdate) -endif - -! TODO: Keep halo corners check for future use? -! Then add debug conditional . Also, more robust rescaling. -! Debug; print the 4x4 arrays (corners & middle) -! to see whether values are copied correctly -! Level 44 values range from 800-eps to 805. I don't want to see the 80. -! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. -! TODO: Convert print to the error handler with conditional -if ( debug > 0 ) then - if (fulldom3d(44,10,10) > 1.e+10) then - normed = fulldom3d(44,:,:) - 1.1092e+10 - debug_format = '(3(4E10.4,2X))' - else if (fulldom3d(44,10,10) < 1000._r4) then - normed = fulldom3d(44,:,:) - 800._r4 - debug_format = '(3(4F10.5,2X))' - endif + ! Space for full domain field (read from filter_output.nc) + ! and halo around the full domain + real(r4), intent(inout) :: fulldom3d(1:nz_per_block, & + 1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost) - ! Debug HDF5 - write(string1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))'),normed(nlat+1,nlon+2) - call error_handler(E_MSG,routine,string1,source,revision,revdate) + character(len=*), parameter :: routine = 'add_halo_fulldom3d' + integer :: g, i,j, haflat,haflon + real(r4), allocatable :: normed(:,:) + character(len=16) :: debug_format - ! 17 format debug_format - print*,'top' - do j = nlat+2,nlat-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) - enddo - print*,'middle' - do j = haflat+2,haflat-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) - enddo - print*,'bottom' - do j = 2,-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) + ! An array for debugging by renormalizing an altitude of fulldom3d. + allocate(normed(1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost)) + + haflat = nlat/2 + haflon = nlon/2 + + do g = 1,nghost + ! left; reach around the date line. + ! There's no data at the ends of the halos for this copy. + fulldom3d (:,1:nlat, 1-g) & + = fulldom3d(:,1:nlat,nlon+1-g) + + ! right + fulldom3d (:,1:nlat,nlon+g) & + = fulldom3d(:,1:nlat,g) + + ! bottom; reach over the S Pole for halo values. + ! There is data at the ends of the halos for these.) + + fulldom3d (:,1-g ,1-nghost :haflon) & + = fulldom3d(:, g ,1-nghost+haflon:nlon) + fulldom3d (:,1-g ,haflon+1:nlon) & + = fulldom3d(:, g ,1 :haflon) + ! Last 2 (halo) points on the right edge (at the bottom) + fulldom3d (:,1-g , nlon+1: nlon+nghost) & + = fulldom3d(:, g ,haflon+1:haflon+nghost) + + ! top + fulldom3d (:,nlat +g ,1-nghost :haflon) & + = fulldom3d(:,nlat+1-g ,1-nghost+haflon:nlon) + fulldom3d (:,nlat +g ,haflon+1:nlon) & + = fulldom3d(:,nlat+1-g ,1 :haflon) + ! Last 2 (halo) points on the right edge (at the top) + fulldom3d (:,nlat +g , nlon+1: nlon+nghost) & + = fulldom3d(:,nlat+1-g ,haflon+1:haflon+nghost) enddo -! TODO: end normed debug conditional section. -endif - -deallocate(normed) - -end subroutine add_halo_fulldom3d - -!================================================================== - -! Transfer part of the full field into a block restart file. - -subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) - -real(r4), intent(in) :: fulldom3d(1:nzPerBlock, & - 1-nGhost:nlat+nGhost, & - 1-nGhost:nlon+nGhost) -character(len=*), intent(in) :: varname -character(len=*), intent(in) :: file_root -integer, intent(in) :: member - -! Don't collect velocity components (6 of them) -! real(r4) :: temp0d -! , temp1d(:) ? -integer :: ncid_output -integer :: ib, jb, nb -integer :: starts(3),ends(3), xcount, ycount, zcount -character(len=256) :: block_file -character(len=*), parameter :: routine = 'filter_io_to_blocks' - -! a temp array large enough to hold any of the -! Lon,Lat or Alt array from a block plus ghost cells -! allocate(temp1d(1-nGhost:max(nxPerBlock,nyPerBlock,nzPerBlock)+nGhost)) - -zcount = nzPerBlock -ycount = nyPerBlock + 2*nGhost -xcount = nxPerBlock + 2*nGhost - - -if (debug > 0) then - write(string1,'(A,I0,A,I0,A)') 'Now putting the data for ',nBlocksLon, & - ' blocks lon by ',nBlocksLat,' blocks lat' - call error_handler(E_MSG,routine,string1,source,revision,revdate) -end if - -starts(3) = 1 -ends(3) = nzPerBlock - -do jb = 1, nBlocksLat - starts(2) = (jb-1)*nyPerBlock - nGhost + 1 - ends(2) = jb *nyPerBlock + nGhost - - do ib = 1, nBlocksLon - starts(1) = (ib-1)*nxPerBlock - nGhost + 1 - ends(1) = ib *nxPerBlock + nGhost - - nb = (jb-1) * nBlocksLon + ib - 1 - - block_file = block_file_name(trim(file_root), member, nb) - ncid_output = open_block_file(block_file, 'readwrite') - ! TODO: error checking; does the block file have the field in it? - - if ( debug > 0 ) then - write(string1,'(/,"block, ib, jb = ", 3(2X,i5))') nb, ib, jb - call error_handler(E_MSG,routine,string1,source,revision,revdate) - write(string1,'(3(A,i5),2(1X,i5))') & - 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount - call error_handler(E_MSG,routine,string1,source,revision,revdate) + if (any(fulldom3d == MISSING_R4)) then + error_string_1 = 'ERROR: some fulldom3d contain MISSING_R4 after halos' + call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + endif + + ! TODO: Keep halo corners check for future use? + ! Then add debug conditional . Also, more robust rescaling. + ! Debug; print the 4x4 arrays (corners & middle) + ! to see whether values are copied correctly + ! Level 44 values range from 800-eps to 805. I don't want to see the 80. + ! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. + ! 2023-12-20; Aaron sent new files with 54 levels. + if (debug >= 100 .and. do_output()) then + if (fulldom3d(54,10,10) > 1.e+10) then + normed = fulldom3d(54,:,:) - 1.1092e+10 + debug_format = '(3(4E10.4,2X))' + else if (fulldom3d(54,10,10) < 1000._r4) then + normed = fulldom3d(54,:,:) - 800._r4 + debug_format = '(3(4F10.5,2X))' endif + + ! Debug HDF5 + write(error_string_1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))'),normed(nlat+1,nlon+2) + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + + ! 17 format debug_format + print*,'top' + do j = nlat+2,nlat-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) + enddo + print*,'middle' + do j = haflat+2,haflat-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) + enddo + print*,'bottom' + do j = 2,-1, -1 + write(*,debug_format) (normed(j,i),i= -1, 2), & + (normed(j,i),i=haflon-1,haflon+2), & + (normed(j,i),i= nlon-1, nlon+2) + enddo + endif + + deallocate(normed) + + end subroutine add_halo_fulldom3d - call nc_put_variable(ncid_output, trim(varname), & - fulldom3d(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & - context=routine, nc_count=(/zcount,ycount,xcount/) ) - - call nc_close_file(ncid_output) - - enddo -enddo - -! -! !alex begin: added f107 and Rho to the restart files: -! read(iunit) temp0d -! data0d = temp0d -! call get_index_from_gitm_varname('f107', inum, ivals) -! if (inum > 0) then -! call read_filter_io_block0d(ncid, ivals(1), data0d) -! if (data0d < 0.0_r8) data0d = 60.0_r8 !alex -! write(ounit) data0d -! else -! write(ounit) temp0d -! endif - -end subroutine filter_io_to_blocks - -!================================================================== - - -!> put the f107 estimate (scalar) from the statevector into a 0d container -!> the only trick this routine does is give all blocks the same f107 (the -!> f107 value from block 1 state vector goes to block 1,2,3,4 restart files) -!> so no matter what, always grab the f107 from block 1 (manipulate -!> the block variable). -!> written by alex - -subroutine read_filter_io_block0d(ncid, ivar, data0d) - -integer, intent(in) :: ncid -integer, intent(in) :: ivar ! index into state structure -real(r8), intent(inout) :: data0d - -character(len=NF90_MAX_NAME) :: varname - -write(varname,'(A)') trim(variable_table(ivar,VT_VARNAMEINDX)) - -call nc_get_variable(ncid, varname, data0d,& - context="read_filter_io_block0d") - -end subroutine read_filter_io_block0d - - -!================================================================== - - -!================================================================== -! -! TODO: Leaving load_up_state_structure_from_file here until we know how we'll handle -! TEC, f107, ...? -! ! Adds a domain to the state structure from a netcdf file -! ! Called from make_variable_table for derived variables. -! subroutine load_up_state_structure_from_file(filename, nvar, domain_name, domain_num) -! -! character(len=*), intent(in) :: filename ! filename to read from -! integer, intent(in) :: nvar ! number of variables in domain -! character(len=*), intent(in) :: domain_name ! restart, secondary -! integer, intent(in) :: domain_num -! -! integer :: i,j -! -! character(len=NF90_MAX_NAME), allocatable :: var_names(:) -! real(r8), allocatable :: clamp_vals(:,:) -! integer, allocatable :: kind_list(:) -! logical, allocatable :: update_list(:) -! -! -! allocate(var_names(nvar), kind_list(nvar), & -! clamp_vals(nvar,2), update_list(nvar)) -! -! update_list(:) = .true. ! default to update state variable -! clamp_vals(:,:) = MISSING_R8 ! default to no clamping -! -! j = 0 -! do i = 1, nfields -! if (variable_table(i,VT_ORIGININDX) == trim(domain_name)) then -! j = j+1 -! var_names(j) = variable_table(i, VT_VARNAMEINDX) -! kind_list(j) = get_index_for_quantity(variable_table(i, VT_KINDINDX)) -! if (variable_table(i, VT_MINVALINDX) /= 'NA') then -! read(variable_table(i, VT_MINVALINDX), '(d16.8)') clamp_vals(j,1) -! endif -! if (variable_table(i, VT_MAXVALINDX) /= 'NA') then -! read(variable_table(i, VT_MAXVALINDX), '(d16.8)') clamp_vals(j,2) -! endif -! if (variable_table(i, VT_STATEINDX) == 'NO_COPY_BACK') then -! update_list(j) = .false. -! endif -! endif -! enddo -! -! domain_id(domain_num) = add_domain(filename, nvar, & -! var_names, kind_list, clamp_vals, update_list) -! -! ! remove top level from all lev variables - this is the boundary condition -! call hyperslice_domain(domain_id(domain_num), ALT_DIM_NAME, nalt) -! -! deallocate(var_names, kind_list, clamp_vals, update_list) -! -! end subroutine load_up_state_structure_from_file -! -!================================================================== -! -! subroutine extrapolate_vtec(state_handle, ens_size, lon_index, lat_index, vTEC) -! ! -! ! Create the vTEC from constituents in state. -! ! -! -! type(ensemble_type), intent(in) :: state_handle -! integer, intent(in) :: ens_size -! integer, intent(in) :: lon_index, lat_index -! real(r8), intent(out) :: vTEC(ens_size) -! -! ! n(i)levs x ensmeble size -! real(r8), allocatable, dimension(:,:) :: NE -! real(r8), allocatable, dimension(:,:) :: TI, TE -! real(r8), allocatable, dimension(:,:) :: NEm_extended -! real(r8), allocatable, dimension(:,:) :: NE_middle -! real(r8), dimension(ens_size) :: GRAVITYtop, Tplasma, Hplasma -! -! real(r8), PARAMETER :: k_constant = 1.381e-23_r8 ! m^2 * kg / s^2 / K -! real(r8), PARAMETER :: omass = 2.678e-26_r8 ! mass of atomic oxgen kg -! -! real(r8) :: earth_radiusm -! integer :: naltX, nilevX, j, i, var_id -! integer(i8) :: idx -! -! ! NE are extrapolated -! ! 20 more layers for 2.5 degree resolution -! ! 10 more layers for 5 degree resolution -! if (model_res == 2.5) then -! naltX = nalt + 20 -! nilevX = nilev + 20 -! else -! naltX = nalt + 10 -! nilevX = nilev + 10 -! endif -! -! -! allocate( NE(nilev, ens_size), NEm_extended(nilevX, ens_size)) -! allocate( TI(nalt, ens_size), TE(nalt, ens_size) ) -! allocate( NE_middle(naltX-1, ens_size) ) -! -! ! NE (interfaces) -! var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'NE') -! do i = 1, nilev -! idx = get_dart_vector_index(lon_index,lat_index, i, & -! domain_id(RESTART_DOM), var_id) -! NE(i, :) = get_state(idx, state_handle) -! enddo -! -! ! TI (midpoints) -! var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TI') -! do i = 1, nalt -! idx = get_dart_vector_index(lon_index,lat_index, i, & -! domain_id(RESTART_DOM), var_id) -! TI(i, :) = get_state(idx, state_handle) -! enddo -! -! ! TE (midpoints) -! var_id = get_varid_from_varname(domain_id(RESTART_DOM), 'TE') -! do i = 1, nalt -! idx = get_dart_vector_index(lon_index,lat_index, i, & -! domain_id(RESTART_DOM), var_id) -! TE(i, :) = get_state(idx, state_handle) -! enddo -! -! ! Construct vTEC given the parts -! -! earth_radiusm = earth_radius * 1000.0_r8 ! Convert earth_radius in km to m -! NE = NE * 1.0e+6_r8 ! Convert NE in #/cm^3 to #/m^3 -! -! ! Gravity at the top layer -! ! GRAVITYtop(:) = gravity * (earth_radiusm / (earth_radiusm + ZG(nilev,:))) ** 2 -! -! ! Plasma Temperature -! Tplasma(:) = (TI(nalt-1,:) + TE(nalt-1,:)) / 2.0_r8 -! -! ! Compute plasma scale height -! Hplasma(:) = (2.0_r8 * k_constant / omass ) * Tplasma(:) / GRAVITYtop(:) -! -! NEm_extended(1:nilev,:) = NE -! -! do j = nalt, naltX -! NEm_extended(j,:) = NEm_extended(j-1,:) * exp(-0.5_r8) -! enddo -! -! NE_middle(1:(naltX-1),:) = (NEm_extended(2:naltX,:) + NEm_extended(1:(naltX-1),:)) / 2.0_r8 -! -! do i = 1, ens_size -! ! vTEC(i) = sum(NE_middle(:,i) * delta_ZG(:,i)) * 1.0e-16_r8 ! Convert to TECU (1.0e+16 #/m^2) -! vTEC(i) = sum(NE_middle(:,i) ) * 1.0e-16_r8 ! Convert to TECU (1.0e+16 #/m^2) -! enddo -! -! deallocate( NE, NEm_extended) -! deallocate( TI, TE ) -! deallocate( NE_middle ) -! -! end subroutine extrapolate_vtec -! -! !================================================================== -! -! subroutine vert_interp(state_handle, n, dom_id, var_id, lon_index, lat_index, height, iqty, & -! val, istatus) -! ! returns the value at an arbitrary height on an existing horizontal grid location. -! ! istatus == 0 is success. -! -! type(ensemble_type), intent(in) :: state_handle -! integer, intent(in) :: n ! ensemble_size -! integer, intent(in) :: dom_id -! integer, intent(in) :: var_id -! integer, intent(in) :: lon_index -! integer, intent(in) :: lat_index -! real(r8), intent(in) :: height -! integer, intent(in) :: iqty -! real(r8), intent(out) :: val(n) -! integer, intent(out) :: istatus(n) -! -! logical :: is_pressure -! character(len=NF90_MAX_NAME) :: vertstagger -! -! ! Presume the worst. Failure. -! istatus = 1 -! val = MISSING_R8 -! -! is_pressure = (iqty == QTY_PRESSURE) -! if (is_pressure) then -! vertstagger = 'ilev' -! else -! vertstagger = ilev_or_lev(dom_id, var_id) -! endif -! -! if (vertstagger == 'ilev') then -! call vert_interp_ilev(state_handle, height, n, lon_index, lat_index, is_pressure, & -! dom_id, var_id, val, istatus) -! elseif (vertstagger == ALT_DIM_NAME) then -! call vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & -! dom_id, var_id, val, istatus) -! endif -! -! end subroutine vert_interp -! -!================================================================== -! -! subroutine find_qty_in_state(iqty, which_dom, var_id) -! ! Returns the variable id for a given DART qty -! ! Will return X rather than X_MN variable. -! -! integer, intent(in) :: iqty -! integer, intent(out) :: which_dom -! integer, intent(out) :: var_id -! -! integer :: num_same_kind, id, k -! integer, allocatable :: multiple_kinds(:), n -! character(NF90_MAX_NAME) :: varname -! -! which_dom = -1 -! var_id = -1 -! -! do id = 1, get_num_domains() ! RESTART_DOM, SECONDARY_DOM, CONSTRUCT_DOM -! -! num_same_kind = get_num_varids_from_kind(domain_id(id), iqty) -! if (num_same_kind == 0 ) cycle -! if (num_same_kind > 1 ) then ! need to pick which one you want -! which_dom = id -! allocate(multiple_kinds(num_same_kind)) -! call get_varids_from_kind(domain_id(id), iqty, multiple_kinds) -! do k = 1, num_same_kind -! varname = adjustl(get_variable_name(domain_id(id), multiple_kinds(k))) -! n = len(trim(varname)) -! if (n <= 2) then ! variable name can not be X_MN -! var_id = multiple_kinds(k) -! exit -! elseif (trim(varname(n-2:n)) == '_NM') then ! variable name is _MN -! cycle ! assuming we want the X, not the X_MN -! else -! var_id = multiple_kinds(k) -! exit -! endif -! enddo -! deallocate(multiple_kinds) -! else ! -! which_dom = id -! var_id = get_varid_from_kind(domain_id(id), iqty) -! endif -! enddo -! -! end subroutine find_qty_in_state -! -!================================================================== - -! find enclosing lon indices -! Compute bracketing lon indices: -! TIEGCM [-180 175] DART [180, 185, ..., 355, 0, 5, ..., 175] -subroutine compute_bracketing_lon_indices(lon, idx_below, idx_above, fraction) - -real(r8), intent(in) :: lon ! longitude -integer, intent(out) :: idx_below, idx_above ! index in lons() -real(r8), intent(out) :: fraction ! fraction to use for interpolation - -if(lon >= top_lon .and. lon < bot_lon) then ! at wraparound point [175 <= lon < 180] - idx_below = nlon - idx_above = 1 - fraction = (lon - top_lon) / delta_lon -elseif (lon >= bot_lon) then ! [180 <= lon <= 360] - idx_below = int((lon - bot_lon) / delta_lon) + 1 - idx_above = idx_below + 1 - fraction = (lon - lons(idx_below)) / delta_lon -else ! [0 <= lon <= 175 ] - idx_below = int((lon - 0.0_r8) / delta_lon) + zero_lon_index - idx_above = idx_below + 1 - fraction = (lon - lons(idx_below)) / delta_lon -endif - - -end subroutine compute_bracketing_lon_indices +!-------------------------------------------------------------------- +! Transfer part of the full field into a block restart file. -!================================================================== -! -! ! on lev -! subroutine vert_interp_lev(state_handle, height, n, lon_index, lat_index, is_pressure, & -! dom_id, var_id, val, istatus) -! -! type(ensemble_type), intent(in) :: state_handle -! real(r8), intent(in) :: height -! integer, intent(in) :: n ! ensemble size -! integer, intent(in) :: lon_index -! integer, intent(in) :: lat_index -! logical, intent(in) :: is_pressure -! integer, intent(in) :: dom_id, var_id -! real(r8), intent(out) :: val(n) ! interpolated value -! integer, intent(out) :: istatus(n) -! -! integer :: lev(n), lev_minus_one(n), lev_plus_one(n) -! real(r8) :: frac_lev(n) -! -! integer :: k, i -! real(r8) :: delta_z(n) -! real(r8) :: zgrid_upper(n), zgrid_lower(n) ! ZG on midpoints -! real(r8) :: z_k(n), z_k_minus_one(n), z_k_plus_one(n) ! ZG on ilves -! integer(i8) :: indx_top(n), indx_bottom(n) ! state vector indices for qty -! integer(i8) :: indx(n), indx_minus_one(n), indx_plus_one(n) ! state vector indices for ZG -! logical :: found(n) ! track which ensemble members have been located -! real(r8) :: val_top(n), val_bottom(n) -! -! istatus = 1 -! found = .false. -! -! ! Variable is on level midpoints, not ilevels. -! ! Get height as the average of the ilevels. -! -! ! ilev index 1 2 3 4 ... 27 28 29 -! ! ilev value -7.00, -6.50, -6.00, -5.50, ... 6.00, 6.50, 7.00 ; -! ! lev value -6.75, -6.25, -5.75, -5.25, ... 6.25, 6.75 -! ! lev index 1 2 3 4 ... 27 28 -! -! !mid_level 1 -! zgrid_lower(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,1, & -! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & -! (get_state(get_dart_vector_index(lon_index,lat_index,2, & -! domain_id(SECONDARY_DOM), ivarZG), state_handle) /100.0_r8) ) / 2.0_r8 -! -! !mid_level nalt -! zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,nilev-1, & -! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) + & -! (get_state(get_dart_vector_index(lon_index,lat_index,nilev, & -! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) ) / 2.0_r8 -! -! ! cannot extrapolate below bottom or beyond top -! do i = 1, n -! if ((zgrid_lower(i) > height) .or. (zgrid_upper(i) < height)) then -! istatus(i) = 55 -! endif -! enddo -! if (any(istatus == 55)) return ! ! fail if any ensemble member fails -! -! ! Figure out what level is above/below, and by how much -! h_loop_midpoint: do k = 2, nilev-1 -! -! zgrid_upper(:) = ( (get_state(get_dart_vector_index(lon_index,lat_index,k, & -! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8 ) + & -! (get_state(get_dart_vector_index(lon_index,lat_index,k+1, & -! domain_id(SECONDARY_DOM), ivarZG), state_handle)/100.0_r8) ) / 2.0_r8 -! -! ! per ensemble member -! do i = 1, n -! if (found(i)) cycle -! if (height <= zgrid_upper(i)) then -! found(i) = .true. -! lev(i) = k -! lev_minus_one(i) = lev(i) - 1 -! lev_plus_one(i) = lev(i) + 1 -! if (all(found)) exit h_loop_midpoint -! endif -! enddo -! -! enddo h_loop_midpoint -! -! do i = 1, n -! indx(i) = get_dart_vector_index(lon_index,lat_index,lev(i), domain_id(SECONDARY_DOM), ivarZG) -! indx_minus_one(i) = get_dart_vector_index(lon_index,lat_index,lev_minus_one(i), domain_id(SECONDARY_DOM), ivarZG) -! indx_plus_one(i) = get_dart_vector_index(lon_index,lat_index,lev_plus_one(i), domain_id(SECONDARY_DOM), ivarZG) -! enddo -! -! call get_state_array(z_k(:),indx(:), state_handle) -! call get_state_array(z_k_minus_one, indx_minus_one(:), state_handle) -! call get_state_array(z_k_plus_one, indx_plus_one(:), state_handle) -! -! -! !lower midpoint -! zgrid_lower(:) = ( z_k(:) + z_k_minus_one ) / 2.0_r8 / 100.0_r8 -! -! ! upper midpoint -! zgrid_upper(:) = ( z_k(:) + z_k_plus_one ) / 2.0_r8 / 100.0_r8 -! -! where (zgrid_upper == zgrid_lower) ! avoid divide by zero -! frac_lev = 0.0_r8 -! delta_z = 0.0_r8 -! elsewhere -! delta_z = zgrid_upper - zgrid_lower -! frac_lev = (zgrid_upper - height)/delta_z -! endwhere -! -! if (is_pressure) then ! get fom plevs -! -! val_top(:) = plevs(lev(:)) !pressure at midpoint [Pa] -! val_bottom(:) = plevs(lev_minus_one(:)) !pressure at midpoint [Pa] -! val(:) = exp(frac_lev(:) * log(val_bottom(:)) + (1.0 - frac_lev(:)) * log(val_top(:))) -! -! else ! get from state vector -! -! do i = 1, n -! indx_top(i) = get_dart_vector_index(lon_index,lat_index,lev(i), dom_id, var_id) -! indx_bottom(i) = get_dart_vector_index(lon_index,lat_index,lev_minus_one(i), dom_id, var_id) -! enddo -! -! call get_state_array(val_top, indx_top(:), state_handle) -! call get_state_array(val_bottom, indx_bottom(:), state_handle) -! -! val(:) = frac_lev(:) * val_bottom(:) + (1.0 - frac_lev(:)) * val_top(:) -! -! endif -! -! istatus(:) = 0 -! -! end subroutine vert_interp_lev -! -! !================================================================== -! -! ! Compute neighboring lat rows: TIEGCM [-87.5, 87.5] DART [-90, 90] -! ! Poles >|87.5| set to |87.5| -! subroutine compute_bracketing_lat_indices(lat, idx_below, idx_above, fraction) -! -! real(r8), intent(in) :: lat ! latitude -! integer, intent(out) :: idx_below, idx_above ! index in lats() -! real(r8), intent(out) :: fraction ! fraction to use for interpolation -! -! if(lat >= bot_lat .and. lat < top_lat) then ! -87.5 <= lat < 87.5 -! idx_below = int((lat - bot_lat) / delta_lat) + 1 -! idx_above = idx_below + 1 -! fraction = (lat - lats(idx_below) ) / delta_lat -! else if(lat < bot_lat) then ! South of bottom lat -! idx_below = 1 -! idx_above = 1 -! fraction = 1.0_r8 -! else ! On or North of top lat -! idx_below = nlat -! idx_above = nlat -! fraction = 1.0_r8 -! endif -! -! end subroutine compute_bracketing_lat_indices -! -! !------------------------------------------------------------------------------- -! function interpolate(n, lon_fract, lat_fract, val11, val12, val21, val22) result(obs_val) -! -! integer, intent(in) :: n ! number of ensemble members -! real(r8), intent(in) :: lon_fract, lat_fract -! real(r8), dimension(n), intent(in) :: val11, val12, val21, val22 -! real(r8), dimension(n) :: obs_val -! -! real(r8) :: a(n, 2) -! -! a(:, 1) = lon_fract * val21(:) + (1.0_r8 - lon_fract) * val11(:) -! a(:, 2) = lon_fract * val22(:) + (1.0_r8 - lon_fract) * val12(:) -! -! obs_val(:) = lat_fract * a(:,2) + (1.0_r8 - lat_fract) * a(:,1) -! -! end function interpolate -! -! !------------------------------------------------------------------------------- -! function ilev_or_lev(dom_id, var_id) result(dim_name) -! -! integer, intent(in) :: dom_id -! integer, intent(in) :: var_id -! character(len=NF90_MAX_NAME) :: dim_name -! -! integer :: d -! ! search for either ilev or lev -! dim_name = 'null' -! do d = 1, get_num_dims(dom_id, var_id) -! dim_name = get_dim_name(dom_id, var_id, d) -! if (dim_name == 'ilev' .or. dim_name == ALT_DIM_NAME) exit -! enddo -! -! end function ilev_or_lev -!=============================================================================== + subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) + + real(r4), intent(in) :: fulldom3d(1:nz_per_block, & + 1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost, 1) + character(len=*), intent(in) :: varname + character(len=*), intent(in) :: file_root + integer, intent(in) :: member + + ! Don't collect velocity components (6 of them) + ! real(r4) :: temp0d + ! , temp1d(:) ? + integer :: ncid_output + integer :: ib, jb, nb + integer :: starts(3),ends(3), xcount, ycount, zcount + character(len=256) :: block_file + character(len=*), parameter :: routine = 'filter_io_to_blocks' + + ! a temp array large enough to hold any of the + ! Lon,Lat or Alt array from a block plus ghost cells + ! allocate(temp1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) + + + zcount = nz_per_block + ycount = ny_per_block + 2*nghost + xcount = nx_per_block + 2*nghost + + + if (debug > 0 .and. do_output()) then + write(error_string_1,'(A,I0,A,I0,A)') 'Now putting the data for ',nblocks_lon, & + ' blocks lon by ',nblocks_lat,' blocks lat' + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + end if + + starts(1) = 1 + ends(1) = nz_per_block + + do jb = 1, nblocks_lat + starts(2) = (jb-1)*ny_per_block - nghost + 1 + ends(2) = jb *ny_per_block + nghost + + do ib = 1, nblocks_lon + starts(3) = (ib-1)*nx_per_block - nghost + 1 + ends(3) = ib *nx_per_block + nghost + + nb = (jb-1) * nblocks_lon + ib - 1 + + block_file = block_file_name(trim(file_root), member, nb) + ncid_output = open_block_file(block_file, 'readwrite') + + ! TODO: error checking; does the block file have the field in it? + ! convert prints to error_handler + if ( debug > 0 .and. do_output()) then + write(error_string_1,'(/,"block, ib, jb = ", 3(2X,i5))') nb, ib, jb + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,'(3(A,i5),2(1X,i5))') & + 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount + call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + endif + + call nc_put_variable(ncid_output, trim(varname), & + fulldom3d(starts(1):ends(1), starts(2):ends(2), starts(3):ends(3), 1:1), & + context=routine, nc_count=(/zcount,ycount,xcount,1/) ) + + call nc_close_file(ncid_output) + + enddo + enddo + + ! + ! !alex begin: added f107 and Rho to the restart files: + ! read(iunit) temp0d + ! data0d = temp0d + ! call get_index_from_gitm_varname('f107', inum, ivals) + ! if (inum > 0) then + ! call read_filter_io_block0d(ncid, ivals(1), data0d) + ! if (data0d < 0.0_r8) data0d = 60.0_r8 !alex + ! write(ounit) data0d + ! else + ! write(ounit) temp0d + ! endif + + end subroutine filter_io_to_blocks + + + +!=================================================================== ! End of model_mod -!=============================================================================== +!=================================================================== end module model_mod + diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index bcec24c00a..24c1ccc070 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -1,89 +1,32 @@ +Ben's: namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables + +Future?: +x estimate_f10_7 = .false. +x f10_7_file_name = 'f10_7.nc' +Not namelist (recompile for a big change like this): +x calendar = 'Gregorian' + &model_nml + filter_io_filename = 'other than filter_input_0001.nc' debug = 100 - filter_io_dir = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata2' - estimate_f10_7 = .false. - f10_7_file_name = 'f10_7.nc' variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'O+', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' - calendar = 'Gregorian' - assimilation_period_seconds = 3600 + 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + time_step_days = 0 + time_step_seconds = 3600 / + ! >>> Don't code these until we get new CF-compliant field names from Aaron. <<< ! >>> Not all fields have halos suitable for calculating gradients. These do (2023-11-8): ! neutral temperature, O, O2, N2, and the horizontal winds. ! The current model_mod will fill all halos anyway, since that's simpler and won't break the model. ! Other neutrals from restart files, which Aaron identified as important: - Zonal\ Wind - Meridional\ Wind + Zonal\ Wind + Meridional\ Wind ! Other ions from restart files, which Aaron identified as important: - O2+ - O+2D - O+2P - N2+ + O2+ + O+2D + O+2P + N2+ ! Other neutrals - Vertical\ Wind - - 'TI', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'restart', 'UPDATE', - 'TE', 'QTY_TEMPERATURE_ELECTRON', 'NA', 'NA', 'restart', 'UPDATE', - 'OP_NM', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', - 'O1', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.99999', 'restart', 'NO_COPY_BACK', - 'O2', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.99999', 'restart', 'UPDATE', - 'TN', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'UPDATE', -Delete from namelist - assimilation_period_seconds = 3600 - tiegcm_restart_file_name = 'tiegcm_restart_p.nc' - tiegcm_secondary_file_name = 'tiegcm_s.nc' - - -! GITM: -# The list of variables to put into the state vector is here: -# The definitions for the DART kinds are in DART/obs_def/obs_def*f90 -# The order doesn't matter to DART. It may to you. - -! &model_nml - gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', - assimilation_period_days = 0, - assimilation_period_seconds = 1800, - model_perturbation_amplitude = 0.2, - calendar = 'Gregorian', - debug = 0, - gitm_state_variables = - 'Temperature', 'QTY_TEMPERATURE', - 'eTemperature', 'QTY_TEMPERATURE_ELECTRON', - 'ITemperature', 'QTY_TEMPERATURE_ION', - 'iO_3P_NDensityS', 'QTY_DENSITY_NEUTRAL_O3P', - 'iO2_NDensityS', 'QTY_DENSITY_NEUTRAL_O2', - 'iN2_NDensityS', 'QTY_DENSITY_NEUTRAL_N2', - 'iN_4S_NDensityS', 'QTY_DENSITY_NEUTRAL_N4S', - 'iNO_NDensityS', 'QTY_DENSITY_NEUTRAL_NO', - 'iN_2D_NDensityS', 'QTY_DENSITY_NEUTRAL_N2D', - 'iN_2P_NDensityS', 'QTY_DENSITY_NEUTRAL_N2P', - 'iH_NDensityS', 'QTY_DENSITY_NEUTRAL_H', - 'iHe_NDensityS', 'QTY_DENSITY_NEUTRAL_HE', - 'iCO2_NDensityS', 'QTY_DENSITY_NEUTRAL_CO2', - 'iO_1D_NDensityS', 'QTY_DENSITY_NEUTRAL_O1D', - 'iO_4SP_IDensityS', 'QTY_DENSITY_ION_O4SP', - 'iO2P_IDensityS', 'QTY_DENSITY_ION_O2P', - 'iN2P_IDensityS', 'QTY_DENSITY_ION_N2P', - 'iNP_IDensityS', 'QTY_DENSITY_ION_NP', - 'iNOP_IDensityS', 'QTY_DENSITY_ION_NOP', - 'iO_2DP_IDensityS', 'QTY_DENSITY_ION_O2DP', - 'iO_2PP_IDensityS', 'QTY_DENSITY_ION_O2PP', - 'iHP_IDensityS', 'QTY_DENSITY_ION_HP', - 'iHeP_IDensityS', 'QTY_DENSITY_ION_HEP', - 'ie_IDensityS', 'QTY_DENSITY_ION_E', - 'U_Velocity_component', 'QTY_VELOCITY_U', - 'V_Velocity_component', 'QTY_VELOCITY_V', - 'W_Velocity_component', 'QTY_VELOCITY_W', - 'U_IVelocity_component', 'QTY_VELOCITY_U_ION', - 'V_IVelocity_component', 'QTY_VELOCITY_V_ION', - 'W_IVelocity_component', 'QTY_VELOCITY_W_ION', - 'iO_3P_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_O3P', - 'iO2_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_O2', - 'iN2_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_N2', - 'iN_4S_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_N4S', - 'iNO_VerticalVelocity', 'QTY_VELOCITY_VERTICAL_NO', - 'f107', 'QTY_1D_PARAMETER', - 'Rho', 'QTY_DENSITY', - / + Vertical\ Wind diff --git a/models/aether_lon-lat/transform_names.f90 b/models/aether_lon-lat/transform_names.f90 new file mode 100644 index 0000000000..cc869d4bc9 --- /dev/null +++ b/models/aether_lon-lat/transform_names.f90 @@ -0,0 +1,134 @@ +program transform_names + +! Test the functions that will go into model_mod for use by aether_to_dart +! and dart_to_aether to convert Aether field names to CF compliant DART names. +! + +! use netcdf +! use typesizes +use types_mod, only : MISSING_I + +! Why not? character (len=NF90_MAX_NAME) :: aether_name, dart_name +character (len=256) :: aether_name, dart_name + +aether_name = '' +read '(A)', aether_name + +dart_name = aeth_name_to_dart(aether_name) +print*, trim(dart_name), '||end' + +contains +!----------------------------------------------------------------------------- +! Translate an Aether field name (not CF-compliant) into a form filter likes. +! E.g. 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', -> +! 'Opos_Perp_Ion_Vel_Merid' +function aeth_name_to_dart(varname) + +! character(len=NF90_MAX_NAME), intent(in) :: varname +character(len=256), intent(in) :: varname + +! character(len=NF90_MAX_NAME) :: aeth +character(len=256) :: aeth +character(len=128) :: aeth_name_to_dart +character(len=32) :: parts(8), var_root +integer :: char_num, first, i_parts, aeth_len, end_str + +aeth = trim(varname) +aeth_len = len_trim(varname) +parts = '' + +! Look for the last ' '. The characters after that are the species. +! If there's no ' ', the whole string is the species. +char_num = 0 +char_num = scan(trim(aeth),' ',back=.true.) +print*,'species blank at ',char_num +var_root = aeth(char_num+1:aeth_len) +print*,'species var_root = ', var_root +end_str = char_num + +! purge_chars removes unwanted [()\] +! Remove blanks from front and end. +parts(1) = purge_chars( trim(var_root),')(\' ) +print*,'parts(1) = ',parts(1) + +! Tranform remaining pieces of varname into DART versions. +char_num = MISSING_I +first = 1 +i_parts = 2 +do + ! This returns the position of the first blank *within the substring* passed in. + char_num = scan(aeth(first:end_str),' ',back=.false.) + print*,'char_num, aeth substring = ',char_num, aeth(first:end_str),'||end' + if (char_num > 0 .and. first < aeth_len) then + parts(i_parts) = purge_chars(aeth(first:first+char_num-1), '.)(\' ) + + first = first + char_num + print*,'parts(i_parts), first, aeth_len = ' ,parts(i_parts), first , aeth_len + i_parts = i_parts + 1 + else + exit + endif +enddo + +! Construct the DART field name from the parts +aeth_name_to_dart = trim(parts(1)) +i_parts = 2 +do +if (trim(parts(i_parts)) /= '') then + aeth_name_to_dart = trim(aeth_name_to_dart)//'_'//trim(parts(i_parts)) + print*,'i_parts, aeth_name_to_dart = ' ,i_parts, aeth_name_to_dart + i_parts = i_parts + 1 +else + exit +endif +enddo + +end function aeth_name_to_dart + +!----------------------------------------------------------------- +! Replace undesirable characters with better. + +function purge_chars(ugly_string, chars) + +character (len=*), intent(in) :: ugly_string, chars +character (len=32) :: purge_chars, temp_str + +integer :: char_num, end_str, pm_num + +! Trim is not needed here +purge_chars = ugly_string +char_num = MISSING_I +do + ! Returns 0 if chars are not found + char_num = scan(trim(purge_chars),chars) + ! Need to change it to a char that won't be found by scan in the next iteration, + ! and can be easily removed. + print*,'purge_chars: purge_chars, char_num = ',trim(purge_chars),' ', char_num + if (char_num > 0) then + purge_chars(char_num:char_num) = ' ' + else + exit + endif +enddo + +! Replace + and - with pos and neg. Assume there's only 1. +temp_str = trim(adjustl(purge_chars)) +end_str = len_trim(temp_str) +pm_num = scan(trim(temp_str),'+-',back=.false.) +if (pm_num == 0) then + purge_chars = trim(temp_str) +else + if (temp_str(pm_num:pm_num) == '+') then + purge_chars = temp_str(1:pm_num-1)//'pos' + else if (temp_str(pm_num:pm_num) == '-') then + purge_chars = temp_str(1:pm_num-1)//'neg' + endif + if (pm_num+1 <= end_str) & + purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) +endif + + +end function purge_chars + +end program + diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index a9aaa62c4e..fdfca50336 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -163,14 +163,12 @@ # / &model_nml - debug = 100 - filter_io_dir = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' - estimate_f10_7 = .false. - f10_7_file_name = 'f10_7.nc' + filter_io_filename = 'filter_input_0001.nc' variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'O+', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' - calendar = 'Gregorian' - assimilation_period_seconds = 3600 + 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + time_step_days = 0 + time_step_seconds = 3600 + debug = 10 / ! >>> Don't code these until we get new CF-compliant field names from Aaron. <<< ! Other neutrals from restart files, which Aaron identified as important: @@ -185,13 +183,13 @@ Vertical\ Wind &aether_to_dart_nml - aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' + aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' filter_io_root = 'filter_input' variables = - 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', + 'Temperature', 'QTY_TEMPERATURE', 'NA', '10000.0', 'neutrals', 'UPDATE', + 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' 'NA', 'NA', 'neutrals', 'UPDATE', 'O+', - 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + 'QTY_DENSITY_ION_OP', '0.', 'NA', 'ions', 'UPDATE' 'Temperature\ \(O+\)', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', @@ -206,10 +204,11 @@ 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' + debug = 5 / &dart_to_aether_nml - aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata1/restartOut.Sphere.1member' + aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' filter_io_root = 'filter_output', variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', @@ -230,6 +229,7 @@ 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' + debug = 5 / ! 4 digit member number and .nc will be appended to this. @@ -249,8 +249,8 @@ / &obs_kind_nml - assimilate_these_obs_types = 'CHAMP_DENSITY', 'GPS_VTEC_EXTRAP', 'GPS_PROFILE', 'COSMIC_ELECTRON_DENSITY' - evaluate_these_obs_types = 'GND_GPS_VTEC' + assimilate_these_obs_types = 'GPS_VTEC_EXTRAP', 'GPS_PROFILE', 'COSMIC_ELECTRON_DENSITY' + evaluate_these_obs_types = '' / &location_nml @@ -290,6 +290,7 @@ logfilename = 'dart_log.out' nmlfilename = 'dart_log.nml' write_nml = 'file' + print_debug = .true. / &mpi_utilities_nml @@ -375,21 +376,49 @@ max_lon = 360.0 / + test 6 produces an exhaustive list of metadata for EVERY element in the DART state vector. + num_ens must = 1 + x_ind is for test3. The default (-1) will fail. + interp_test_dX are the model grid resolutions, + or numbers to use as such in the testing. + _d[xyz] is for cartesian grids, + _d{lon,lat,vert} is for spherical grids + interp_test_d[xyz] take precedence over d{lon,lat,vert} + all 3 must be specified. + aether (54 levels) dz ranges from ~1500 in the low levels to ~15,000 at the top. + interp_test_{lon,lat,vert}range; model domain limits (or a subdomain?) + Aether longitudes; in the filter_input_#.nc some are not whole numbers.; 75.00001 + Doc error: web page says run_tests uses entries from test1thru, + but that has test 0, which is not an option in model_mod_check. + tests_to_run is not dimensioned '(0:'. + &model_mod_check_nml - input_state_files = "tiegcm_restart_p.nc", "tiegcm_s.nc" - output_state_files = "mmc_output_p.nc", "mmc_output_s.nc" - test1thru = 7 - run_tests = 0,1,2,3,4,5,7 - x_ind = 1 - loc_of_interest = 240.0, 12.49, 200000.0 + num_ens = 1 + single_file = .FALSE. + input_state_files = 'filter_input_0001.nc' + output_state_files = 'filter_output_0001.nc' quantity_of_interest = 'QTY_DENSITY_ION_OP' - interp_test_dlon = 5 - interp_test_dlat = 5 - interp_test_dvert = 50000.0 + all_metadata_file = 'test6_metadata.txt' + x_ind = 1234 + loc_of_interest = 15.0, -2.5, 100000. + interp_test_dlon = 10.0 + interp_test_dlat = 5.0 + interp_test_dvert = 1500.0 interp_test_lonrange = 0, 360 interp_test_latrange = -87.5, 87.5 - interp_test_vertrange = 200000.0, 300000.0 + interp_test_vertrange = 96952.5625, 436360.25 + interp_test_dx = -888888.0 + interp_test_dy = -888888.0 + interp_test_dz = -888888.0 + interp_test_xrange = -888888.0, -888888.0 + interp_test_yrange = -888888.0, -888888.0 + interp_test_zrange = -888888.0, -888888.0 interp_test_vertcoord = 'VERTISHEIGHT' - verbose = .false. - / + test1thru = -1 + run_tests = 1,2,3,4,5,7 + verbose = .FALSE. + / +&quad_interpolate_nml + debug = 999 +/ diff --git a/models/aether_lon-lat/work/quickbuild.sh b/models/aether_lon-lat/work/quickbuild.sh index a329e655a7..9008223e85 100755 --- a/models/aether_lon-lat/work/quickbuild.sh +++ b/models/aether_lon-lat/work/quickbuild.sh @@ -27,6 +27,7 @@ obs_seq_to_netcdf model_serial_programs=( aether_to_dart +transform_names dart_to_aether) arguments "$@" @@ -44,7 +45,7 @@ buildpreprocess buildit # clean up -\rm -f -- *.o *.mod +# \rm -f -- *.o *.mod } From a928e3e0e5e7f7b08869b6ecfb6c32e48768d759 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sat, 20 Jan 2024 15:13:59 -0700 Subject: [PATCH 057/124] Convert original Aether variable names to new This matlab script creates new block restart files with the names Aaron provided in mid-January, 2024. The data are the same as the input (old names) files. This is a commit of the the development script, which converts only 2 neutrals and 2 ions for the requested number of block(s) and member(0-based). --- .../aether_lon-lat/matlab/new_varname_file.m | 146 ++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100644 models/aether_lon-lat/matlab/new_varname_file.m diff --git a/models/aether_lon-lat/matlab/new_varname_file.m b/models/aether_lon-lat/matlab/new_varname_file.m new file mode 100644 index 0000000000..2d33d50a3a --- /dev/null +++ b/models/aether_lon-lat/matlab/new_varname_file.m @@ -0,0 +1,146 @@ +function new_varname_file(data_dir, member, nblocks) + +% Converts Aether restart file names to updated (2024-1-17) versions. +% Copy the grid files, for completeness, into a new directory. +% Run in that directory. +% Gets all the contents of the existing files +% and writes them to a new file, with new variable names. +% > new_varname_file(data_dir, member, nblocks) +% +% Files are version=2,netcdf=4.9.0,hdf5=1.12.2 + +% neut_old = ["N_4S" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... +% "Zonal Wind" "Meridional Wind" "Vertical Wind"] +neut_old = ["N_4S" "Zonal Wind"]; +neut_new = ["N" "velocity_east"]; +% neut_new = ["N" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... +% "velocity_east" "velocity_north" "velocity_up"] +ions_old = ["O+2P" "Temperature (bulk ion)" ]; +ions_new = ["O+_2P" "Temperature_bulk_ion" ]; +% ions_old = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+2D" "O+2P" ... +% "Temperature (bulk ion)" "Temperature (electron)"] +% ions_new = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+_2D" "O+_2P" ... +% "Temperature_bulk_ion" "Temperature_electron"] + +global fname_old fname +format compact + +for b = 0:nblocks-1 + % Neutrals + fname = sprintf('neutrals_m%04d_g%04d.nc', member, b) + fname_old = strcat(data_dir,fname) + + create_file_skel() + add_vars(neut_old, neut_new, b) + + % Ions + fname = sprintf('ions_m%04d_g%04d.nc', member, b) + fname_old = strcat(data_dir,fname) + + create_file_skel() + add_vars(ions_old, ions_new, b) + +end + +%- - - - +function create_file_skel() + +% Create file and define dimensions + + global fname_old fname ncid_old ncid_new + + ncid_old = netcdf.open(fname_old,'NOWRITE') +% ncdisp(fname_old) + [ndims_old,nvars_old,ngatts_old,unlimdimid] = netcdf.inq(ncid_old); + +% I can't make CLOBBER work with whatever permissions Mac and umask allow, +% so remove any existing file manually. Pathetic. + system(['rm ',fname]); +% Ah, I wish they'd mentioned this in the .create page: +% Add write permission to this directory. +% NOPE, needs to operate on an existing file, which I can't create. Brilliant. +% fileattrib('.',"+w") + cmode = netcdf.getConstant('NETCDF4'); + cmode = bitor(cmode,netcdf.getConstant('CLOBBER')); + ncid_new = netcdf.create(fname,cmode); + +% Get dimensions and write them to the new file. + for d = 1:ndims_old + [dimname, dimlen] = netcdf.inqDim(ncid_old,d-1); + dimid = netcdf.inqDimID(ncid_old,dimname); + dimid = netcdf.defDim(ncid_new,dimname,dimlen); + end + netcdf.endDef(ncid_new); + +%- - - - +function add_vars(vars_old, vars_new, b) + + global fname_old fname ncid_old ncid_new + +% time differs from all the others + data = ncread(fname_old,"time"); + dim_list = {"time"}; + nccreate(fname,"time", Dimensions=dim_list, Datatype="double") + ncwrite(fname,"time",data) + + for n = 1:length(vars_old) + add_var(vars_old(n),vars_new(n), b) + + % Ions; add associated variables + if contains(fname,"ions") & ... + ~contains(vars_old(n),"bulk") & ... + ~contains(vars_old(n),"electron") + add_assoc_vars(vars_old(n), vars_new(n), b) + end + end +% + netcdf.close(ncid_new) + netcdf.close(ncid_old) + +% - - - - +function add_var(var_old, var_new, b) + + global fname_old fname + + if b == 0 + sprintf('Renaming %s to %s',var_old,var_new) + end + + data = ncread(fname_old,var_old); + att = ncreadatt(fname_old,var_old,"units"); + + dim_list = {"z","y","x"}; + nccreate (fname, var_new, Dimensions=dim_list, Datatype="single") + ncwrite (fname, var_new, data) + ncwriteatt(fname, var_new,"units",att) + +%- - - - +function add_assoc_vars(var_old, var_new, b) + +% Variables with names associated with ions. +% example 'Parallel Ion Velocity (Zonal) (O+2P)' ... +% The 'Temperature' part of the names is the same, but other parts are different, +% NOTE: These names have the \s removed, but Matlab+NetCDF puts them back in +% in the new file. + i_assoc_old = [ ... + "Temperature" ... + "Parallel Ion Velocity (Zonal)" ... + "Parallel Ion Velocity (Meridional)" ... + "Parallel Ion Velocity (Vertical)" ... + "Perp. Ion Velocity (Zonal)" ... + "Perp. Ion Velocity (Meridional)" ... + "Perp. Ion Velocity (Vertical)" ]; + i_assoc_new = [ ... + "Temperature" ... + "velocity_parallel_east" ... + "velocity_parallel_north" ... + "velocity_parallel_up" ... + "velocity_perp_east" ... + "velocity_perp_north" ... + "velocity_perp_up" ]; + + for a = 1:7 + i_old = strcat(i_assoc_old(a),' (',var_old,')'); + i_new = strcat(i_assoc_new(a),' (',var_new,')'); + add_var(i_old, i_new, b) + end From d88099e419f8b93d4b1fcb88bdc2762d75ab9849 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sun, 21 Jan 2024 07:27:51 -0700 Subject: [PATCH 058/124] new_varname_file.m used to convert ensemble Some of the variable names in the ensemble Aaron sent had already been updated, compared to the restartOut.Sphere.1member... and O was added to the neutrals. This script converts all of the variables and was applied to 20 members. --- .../aether_lon-lat/matlab/new_varname_file.m | 27 ++++++++++++------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/models/aether_lon-lat/matlab/new_varname_file.m b/models/aether_lon-lat/matlab/new_varname_file.m index 2d33d50a3a..d2e0490ff2 100644 --- a/models/aether_lon-lat/matlab/new_varname_file.m +++ b/models/aether_lon-lat/matlab/new_varname_file.m @@ -9,18 +9,27 @@ function new_varname_file(data_dir, member, nblocks) % % Files are version=2,netcdf=4.9.0,hdf5=1.12.2 +% DAI/Aether/Aaron_names/restartOut.Sphere.1member % neut_old = ["N_4S" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... -% "Zonal Wind" "Meridional Wind" "Vertical Wind"] -neut_old = ["N_4S" "Zonal Wind"]; -neut_new = ["N" "velocity_east"]; % neut_new = ["N" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... -% "velocity_east" "velocity_north" "velocity_up"] -ions_old = ["O+2P" "Temperature (bulk ion)" ]; -ions_new = ["O+_2P" "Temperature_bulk_ion" ]; +% testdata2 (ensemble from Aaron) +neut_old = ["O" "N" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... + "Temperature" "Zonal Wind" "Meridional Wind" "Vertical Wind"] +neut_new = ["O" "N" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... + "Temperature" "velocity_east" "velocity_north" "velocity_up"] +% neut_old = ["N_4S" "Zonal Wind"]; +% neut_new = ["N" "velocity_east"]; + +% ions_old = ["O+2P" "Temperature (bulk ion)" ]; +% ions_new = ["O+_2P" "Temperature_bulk_ion" ]; +% DAI/Aether/Aaron_names/restartOut.Sphere.1member % ions_old = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+2D" "O+2P" ... -% "Temperature (bulk ion)" "Temperature (electron)"] % ions_new = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+_2D" "O+_2P" ... -% "Temperature_bulk_ion" "Temperature_electron"] +% testdata2 +ions_old = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+_2D" "O+_2P" ... + "Temperature (bulk ion)" "Temperature (electron)"] +ions_new = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+_2D" "O+_2P" ... + "Temperature_bulk_ion" "Temperature_electron"] global fname_old fname format compact @@ -49,7 +58,7 @@ function create_file_skel() global fname_old fname ncid_old ncid_new - ncid_old = netcdf.open(fname_old,'NOWRITE') + ncid_old = netcdf.open(fname_old,'NOWRITE'); % ncdisp(fname_old) [ndims_old,nvars_old,ngatts_old,unlimdimid] = netcdf.inq(ncid_old); From 54936118cf23f221cec886d1581cb571b87a0aa0 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Thu, 25 Jan 2024 21:04:49 -0700 Subject: [PATCH 059/124] Final Aether field names. Time variable, not dimension. Abandoned using domains for *_to_* (designed for ensembles). Nc_write_model_atts should not define dimensions, especially an UNLIMITED time. That's done by create_and_open_state_output. Instead, the *_to_* programs should write a time scalar variable and not define a time dimension. This commit was tested using aether_to_dart, dart_to_aether, and tests 1-5,7 in model_mod_check. It is a functional baseline before making style and cosmetic changes for the code reviews. Also still to do: update rst files, merge with any updates Ben has made to the assimilation routines, resolve the QTY issue. model_mod.f90 Extracted creation and filling of dimension variables from nc_write_model_atts to a new def_fill_dimvars. Removed time dimension from temp arrays and calls to nc_put_variable. Added 'units' attribute to the filter_input.nc files. aether_to_dart.nml dart_to_aether.nml work/input.nml New Aether field names (complete list) and lists which Aaron says will be important in the state vector. transform_names.f90 removed because it's outdated issue_QTYs File describing the QTY situation for space weather variables as of 2024-1-25. Current testing doesn't require resolution, but future uses probably do. --- models/aether_lon-lat/aether_to_dart.nml | 39 +++-- models/aether_lon-lat/dart_to_aether.nml | 34 +++-- models/aether_lon-lat/issue_QTYs | 169 ++++++++++++++++++++++ models/aether_lon-lat/model_mod.f90 | 112 +++++++------- models/aether_lon-lat/transform_names.f90 | 134 ----------------- models/aether_lon-lat/work/input.nml | 47 +++--- 6 files changed, 301 insertions(+), 234 deletions(-) create mode 100644 models/aether_lon-lat/issue_QTYs delete mode 100644 models/aether_lon-lat/transform_names.f90 diff --git a/models/aether_lon-lat/aether_to_dart.nml b/models/aether_lon-lat/aether_to_dart.nml index 01ba8e0a07..b00babb2c2 100644 --- a/models/aether_lon-lat/aether_to_dart.nml +++ b/models/aether_lon-lat/aether_to_dart.nml @@ -1,33 +1,40 @@ &aether_to_dart_nml aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata2' + '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' filter_io_root = 'filter_input' variables = - 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', + 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', + 'velocity_east', 'QTY_U_WIND_COMPONENT' '1000.0', 'NA', 'neutrals', 'UPDATE', 'O+', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' 'Temperature\ \(O+\)', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'velocity_parallel_east\ \(O+\)', 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'velocity_parallel_north\ \(O+\)', 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'velocity_parallel_up\ \(O+\)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'velocity_perp_east\ \(O+\)', 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'velocity_perp_north\ \(O+\)', 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'velocity_perp_up\ \(O+\)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' debug = 0 / +! Neutrals from restart files, which Aaron identified as important: + Temperature QTY_TEMPERATURE + velocity_east QTY_U_WIND_COMPONENT + velocity_north QTY_V_WIND_COMPONENT + (velocity_up) QTY_VERTICAL_VELOCITY +! Ions from restart files, which Aaron identified as important: + O+ QTY_DENSITY_ION_OP + O2+ QTY_DENSITY_ION_O2P + O+2D QTY_DENSITY_ION_O2DP ? + O+2P QTY_DENSITY_ION_O2PP ? + N2+ QTY_DENSITY_ION_N2P ? -! TODO: Or could use these. What's the difference? -! Would it be useful to use 1 type for Parallel and the other for Perp.? - QTY_VELOCITY_U - QTY_VELOCITY_V - QTY_VELOCITY_W - QTY_VERTICAL_VELOCITY - ... +See ./issue_QTYs for complete lists of variables and potential QTYs + + diff --git a/models/aether_lon-lat/dart_to_aether.nml b/models/aether_lon-lat/dart_to_aether.nml index a42a6dd6c8..9d734458d4 100644 --- a/models/aether_lon-lat/dart_to_aether.nml +++ b/models/aether_lon-lat/dart_to_aether.nml @@ -1,27 +1,37 @@ &dart_to_aether_nml aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata2' + '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' filter_io_root = 'filter_output', variables = - 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', - 'O+', + 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', + 'velocity_east' 'QTY_U_WIND_COMPONENT' '1000.0', 'NA', 'neutrals', 'UPDATE', + 'O+', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' - 'Temperature\ \(O+\)', + 'Temperature (O+)', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'velocity_parallel_east (O+)', 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'velocity_parallel_north (O+)', 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'velocity_parallel_up (O+)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'velocity_perp_east (O+)', 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'velocity_perp_north (O+)', 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'velocity_perp_up (O+)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' debug = 0 / -! 4 digit member number and .nc will be appended to this. +! 4 digit member number and .nc will be appended to filter_io_root. + +Neutrals + Temperature, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2, + velocity_east, velocity_north, velocity_up + QTY_[UV]_WIND_COMPONENT, QTY_VERTICAL_VELOCITY + +Ions + O+, O2+, N2+, NO+, N+, He+, O+_2D, O+_2P, ...? + with the same temperature and velocity components as O+ + diff --git a/models/aether_lon-lat/issue_QTYs b/models/aether_lon-lat/issue_QTYs new file mode 100644 index 0000000000..5cf66a9f0b --- /dev/null +++ b/models/aether_lon-lat/issue_QTYs @@ -0,0 +1,169 @@ + +I'm confused by the selection of QTYs that can be associated +with the Aether variables. I made some choices in the early rush +to get something working, but now I'd like to figure out if they were good choices. +I don't even know how to decide whether it matters (much). + +My first problem is interpretting what the available QTY's represent. +I haven't found a key to decipher the parts of, e.g. QTY_DENSITY_ION_O2DP . +O2 could mean 'oxygen molecule', D could mean an extra or missing electron +from the D orbital, P could be similar, or mean 'positive'. +Or O could mean 'oxygen atom' with 2D or 2DP meaning something. +Comments in space_quantities_mod.f90 or in a docs.dart page would be helpful. + +The Aether variable 'velocity_parallel_up\ \(O+\)' +could potentially have these existing QTYs associated with it: +QTY_VELOCITY_W +QTY_VELOCITY_W_ION +QTY_VERTICAL_VELOCITY +or maybe it should have a new QTY like the existing QTY_VELOCITY_VERTICAL_O2: +QTY_VELOCITY_PARALLEL_VERTICAL_OP +This last seems safest, since each ion has its own 2 vertical velocities. +But I don't know how they'll be used, so maybe a simple, generic QTY +for all the ions is fine. + +2024-1 (final full set) Neutrals + Temperature, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2, + velocity_east, velocity_north, velocity_up + Temperature, + O + N + O2 QTY_DENSITY_NEUTRAL_O2 + N2 QTY_DENSITY_NEUTRAL_N2 + NO + He + N_2D + N_2P + H + O_1D + CO2 + Temperature ; QTY_TEMPERATURE + velocity_east ; QTY_U_WIND_COMPONENT + velocity_north ; QTY_V_WIND_COMPONENT + velocity_up ; QTY_VERTICAL_VELOCITY + +2024-1 (final full set) ions (e- is missing) + O+ + Temperature\ \(O+\) + velocity_parallel_east\ \(O+\) + velocity_parallel_north\ \(O+\) + velocity_parallel_up\ \(O+\) + velocity_perp_east\ \(O+\) + velocity_perp_north\ \(O+\) + velocity_perp_up\ \(O+\) + Repeat the associated vars for: + O2+ + N2+ + NO+ + N+ + He+ + O+_2D + O+_2P + Temperature_bulk_ion + Temperature_electron + + +! These were harvested from the obs_kind_mod.f90 created from + quantity_files = + '../../../assimilation_code/modules/observations/atmosphere_quantities_mod.f90', + '../../../assimilation_code/modules/observations/space_quantities_mod.f90', + '../../../assimilation_code/modules/observations/chemistry_quantities_mod.f90' +! There might be additional relevant QTYs in other quantities_mod.f90 + +! TODO: Or could use these. What's the difference? +! Would it be useful to use 1 type for Parallel and the other for Perp.? + QTY_VELOCITY_U + QTY_VELOCITY_V + QTY_VELOCITY_W + QTY_VERTICAL_VELOCITY + ... +! Note; there are QTYs available for vertical velocity for individual species. + QTY_VELOCITY_VERTICAL_O2 +! But not for the other components + +! or more specific QTYs (but maybe not a complete set?) +! There seems to be choice for for some chemicals, +! which will be guided by which +! assimilation_code/modules/observations/*quantities_mod.f90 +! defines them. +! The chosen files need to be added to the preprocess_nml. +! Full (assembled for my case by preprocess) list: +! (copy candidates to actual names, above) +--- +QTY_TEMPERATURE_ION +QTY_VELOCITY_U_ION +QTY_VELOCITY_V_ION +QTY_VELOCITY_W_ION +--- + +QTY_DENSITY_ION_E 0 +QTY_ELECTRON_DENSITY +QTY_TEMPERATURE_ELECTRON + +QTY_VERTICAL_TEC +--- +QTY_ATOMIC_OXYGEN_MIXING_RATIO +? QTY_DENSITY_NEUTRAL_O1D + +QTY_ION_O_MIXING_RATIO +QTY_DENSITY_ION_OP +--- +QTY_MOLEC_OXYGEN_MIXING_RATIO +QTY_DENSITY_NEUTRAL_O2 +QTY_VELOCITY_VERTICAL_O2 + +QTY_DENSITY_ION_O2P +QTY_DENSITY_ION_O2DP +QTY_DENSITY_ION_O2PP +--- + +QTY_NITROGEN +QTY_DENSITY_NEUTRAL_N2 +QTY_DENSITY_NEUTRAL_N2D +QTY_DENSITY_NEUTRAL_N2P +QTY_VELOCITY_VERTICAL_N2 + +QTY_DENSITY_ION_N2P +--- + +QTY_O_N2_COLUMN_DENSITY_RATIO +--- + +QTY_DENSITY_ION_NP +--- + +QTY_O3 +QTY_DENSITY_NEUTRAL_O3P +QTY_VELOCITY_VERTICAL_O3P +--- + +QTY_DENSITY_NEUTRAL_N4S +QTY_VELOCITY_VERTICAL_N4S +--- + +QTY_NO +QTY_DENSITY_NEUTRAL_NO +QTY_VELOCITY_VERTICAL_NO + +? QTY_DENSITY_ION_NOP +--- + +QTY_DENSITY_NEUTRAL_H +QTY_ATOMIC_H_MIXING_RATIO + +QTY_DENSITY_ION_HP +--- + +QTY_DENSITY_NEUTRAL_HE + +QTY_DENSITY_ION_HEP +--- + +QTY_GND_GPS_VTEC + +Not needed: +QTY_DENSITY_ION_O4SP +QTY_CO +QTY_DENSITY_NEUTRAL_CO2 +QTY_NO2 +QTY_N2O diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index e0b15627b9..37ce65bbfe 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -35,9 +35,9 @@ module model_mod nc_begin_define_mode, nc_end_define_mode, & nc_open_file_readonly, nc_get_dimension_size, nc_create_file, & nc_close_file, nc_get_variable, nc_define_dimension, & - nc_define_real_variable, nc_open_file_readwrite, & + nc_define_real_variable, nc_define_real_scalar, nc_open_file_readwrite, & nc_add_attribute_to_variable, nc_put_variable, & - nc_define_unlimited_dimension, NF90_FILL_REAL + nc_get_attribute_from_variable, NF90_FILL_REAL use quad_utils_mod, only : quad_interp_handle, init_quad_interp, set_quad_coords, & quad_lon_lat_locate, quad_lon_lat_evaluate, & @@ -512,19 +512,38 @@ subroutine nc_write_model_atts(ncid, domain_id) call nc_add_global_attribute(ncid, "model_source", source, routine) call nc_add_global_attribute(ncid, "model", "aether", routine) +! TODO KDR Shouldn't the calendar type be defined here? +! It's defined in the time variable = good enough for write_model_time. -! define grid dimensions +! call nc_end_define_mode(ncid) + +end subroutine nc_write_model_atts + +!------------------------------------------------------------------ +! Add dimension variable contents to the file. + +subroutine def_fill_dimvars(ncid) +integer, intent(in) :: ncid +character(len=*), parameter :: routine = 'def_fill_dimvars' +! call nc_begin_define_mode(ncid) + +! Global atts for aether_to_dart and dart_to_aether. +call nc_add_global_creation_time(ncid, routine) +call nc_add_global_attribute(ncid, "model_source", source, routine) +call nc_add_global_attribute(ncid, "model", "aether", routine) + +! define grid dimensions call nc_define_dimension(ncid, trim(LEV_DIM_NAME), nlev, routine) call nc_define_dimension(ncid, trim(LAT_DIM_NAME), nlat, routine) call nc_define_dimension(ncid, trim(LON_DIM_NAME), nlon, routine) ! TODO: UNLIMITED (time ) should be the last dimension. Document it? -call nc_define_unlimited_dimension(ncid, trim(TIME_DIM_NAME), routine) +! NO. The file should have no time dimension, just a scalar time variable +! call nc_define_unlimited_dimension(ncid, trim(TIME_DIM_NAME), routine) ! define grid variables - ! z call nc_define_real_variable( ncid, trim(LEV_VAR_NAME), (/ trim(LEV_DIM_NAME) /), routine) call nc_add_attribute_to_variable(ncid, trim(LEV_VAR_NAME), 'units', 'm', routine) @@ -541,29 +560,25 @@ subroutine nc_write_model_atts(ncid, domain_id) call nc_add_attribute_to_variable(ncid, trim(LON_VAR_NAME), 'long_name', 'longitude', routine) ! Dimension 'time' will no longer be created by write_model_time, -! since it's explicitly done by nc_define_unlimited_dimension. -! longitude -call nc_define_real_variable( ncid, trim(TIME_VAR_NAME), (/ trim(TIME_VAR_NAME) /), routine) +! or by nc_define_unlimited_dimension. It will be a scalar variable. +! time +call nc_define_real_scalar( ncid, trim(TIME_VAR_NAME), routine) call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'calendar', 'gregorian', routine) call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'units', 'days since 1601-01-01 00:00:00', routine) call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'long_name', 'gregorian_days', routine) - call nc_end_define_mode(ncid) -! TODO: Should nc_write_model_atts write dimension contents, not just atts? -! Gitm had a separate routine for filling the dimensions: -! - - - - - - - - - - - -! subroutine add_nc_dimvars(ncid) call nc_put_variable(ncid, trim(LEV_VAR_NAME), levs, routine) call nc_put_variable(ncid, trim(LAT_VAR_NAME), lats, routine) call nc_put_variable(ncid, trim(LON_VAR_NAME), lons, routine) +! time will be written elsewhere. print*,routine,': passed putting the dimensions' ! Flush the buffer and leave netCDF file open call nc_synchronize_file(ncid) -end subroutine nc_write_model_atts +end subroutine def_fill_dimvars !------------------------------------------------------------------ ! Read dimension information from the template file and use @@ -920,26 +935,27 @@ subroutine restart_files_to_netcdf(member) call error_handler(E_MSG, routine, error_string_1, text2=error_string_2) call error_handler(E_MSG, '', '') -! Debug time UNLIM - ! Enters and exits define mode; - ! nc_write_model_atts puts it in define mode. Is it already there? - ! Then it takes it out of define and leaves file open. - call nc_write_model_atts(ncid, 0) + ! Aether_to_dart and dart_to_aether want only a few lines from + ! nc_write_model_atts -> static_init_model, + ! not domain definition, etc. Put those lines in def_fill_dimvars. + ! TODO: I may need to copy some bits from static_init_model into static_init_blocks + + ! TODO: we haven't settled on the mechanism for identifying the state vector field names and source. + ! TODO: def_fill_dimvars functionality was in nc_write_model_atts but shouldn't have been. + ! I separated nc_write_model_atts into to parts and this is one of them. + ! Is this a good place for the call? It's in the "define" section for the filter_input file. + call def_fill_dimvars(ncid) ! Write_model_time will make a time variable, if needed, which it is not. ! write_model_time does not open the file, call write_model_time(ncid, state_time) + ! Define (non-time) variables call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) - ! TODO: add_nc_dimvars has not been activated because the functionality is in nc_write_model_atts - ! but maybe it shouldn't be. Also, we haven't settled on the mechanism for identifying - ! the state vector field names and source. - ! call add_nc_dimvars(ncid) - + ! Read and convert (non-time) variables call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) ! subr. called by this routine closes the file only if define = .true. - call nc_close_file(ncid) call error_handler(E_MSG, '', '') @@ -1676,15 +1692,14 @@ subroutine write_filter_io(data3d, varname, block, ncid) real(r4), intent(in) :: data3d(1:nz_per_block, & 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost, & - 1) + 1-nghost:nx_per_block+nghost) character(len=vtablenamelength), intent(in) :: varname integer, intent(in) :: block(2) integer, intent(in) :: ncid integer :: ib, jb - integer :: starts(4) + integer :: starts(3) character(len=*), parameter :: routine = 'write_filter_io' @@ -1697,16 +1712,15 @@ subroutine write_filter_io(data3d, varname, block, ncid) starts(1) = 1 starts(2) = (jb-1)*ny_per_block+1 starts(3) = (ib-1)*nx_per_block+1 - starts(4) = 1 ! TODO: convert to error_msg ! print*,routine,'; starts = ',starts ! print*,routine,'; counts = ',nz_per_block,ny_per_block,nx_per_block,1 ! data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & call nc_put_variable(ncid, varname, & - data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block,1), & + data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & context=routine, nc_start=starts, & - nc_count=(/nz_per_block,ny_per_block,nx_per_block,1/)) + nc_count=(/nz_per_block,ny_per_block,nx_per_block/)) ! TODO: convert to error_msg ! print*,routine,': filled varname = ', varname @@ -1722,7 +1736,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) integer, intent(in) :: member logical, intent(in) :: define - real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:,:) + real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) real(r4) :: temp0d !Alex: single parameter has "zero dimensions" integer :: i, j, maxsize, ivar, nb, ncid_input @@ -1731,6 +1745,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) logical :: no_idensity character(len=*), parameter :: routine = 'block_to_filter_io' + character(len=32) :: att_val character(len=128) :: file_root character(len=256) :: filename character(len=vtablenamelength) :: varname, dart_varname @@ -1760,8 +1775,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! temp array large enough to hold 1 species, temperature, etc allocate(temp3d(1:nz_per_block, & 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost, & - 1)) + 1-nghost:nx_per_block+nghost)) ! save density_ion_e to compute TEC allocate(density_ion_e(1:nz_per_block, & @@ -1886,25 +1900,17 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) end if call nc_define_real_variable(ncid_output, dart_varname, & - (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME, TIME_DIM_NAME /) ) - ! TODO: does the filter_input.nc file need all these attributes? TIEGCM doesn't add them. - ! They are not available from the restart files. - ! Add them to the ions section too. - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'long_name', gitmvar(ivar)%long_name) - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'units', gitmvar(ivar)%units) - ! !call nc_add_attribute_to_variable(ncid, dart_varname, 'storder', gitmvar(ivar)%storder) - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_varname', gitmvar(ivar)%gitm_varname) - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_dim', gitmvar(ivar)%gitm_dim) - ! call nc_add_attribute_to_variable(ncid, dart_varname, 'gitm_index', gitmvar(ivar)%gitm_index) - - + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) + call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) + call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units',att_val, routine) + else if (file_root == 'neutrals') then ! Read 3D array and extract the non-halo data of this block. ! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. call nc_get_variable(ncid_input, varname, temp3d, context=routine) if (debug >= 100 .and. do_output()) then ! TODO convert to error_handler? - print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1,1),temp3d(15,15,15,1),varname + print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),varname print*,'block_to_filter_io: define = ',define endif call write_filter_io(temp3d, dart_varname, block, ncid_output) @@ -1939,8 +1945,10 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) end if call nc_define_real_variable(ncid_output, dart_varname, & - (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME, TIME_DIM_NAME /) ) - print*,routine,': defined ivar, dart_varname = ', ivar, dart_varname + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) + call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) + call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units',att_val, routine) + print*,routine,': defined ivar, dart_varname, att = ', ivar, dart_varname,att_val else if (file_root == 'ions') then call nc_get_variable(ncid_input, varname, temp3d, context=routine) @@ -2171,7 +2179,7 @@ subroutine add_halo_fulldom3d(fulldom3d) endif ! Debug HDF5 - write(error_string_1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))'),normed(nlat+1,nlon+2) + write(error_string_1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))') normed(nlat+1,nlon+2) call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) ! 17 format debug_format @@ -2255,9 +2263,9 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) ! TODO: error checking; does the block file have the field in it? ! convert prints to error_handler if ( debug > 0 .and. do_output()) then - write(error_string_1,'(/,"block, ib, jb = ", 3(2X,i5))') nb, ib, jb + write(error_string_1,'(A,3(2X,i5))') "block, ib, jb = ", nb, ib, jb call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,'(3(A,i5),2(1X,i5))') & + write(error_string_1,'(3(A,3i5))') & 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) endif diff --git a/models/aether_lon-lat/transform_names.f90 b/models/aether_lon-lat/transform_names.f90 deleted file mode 100644 index cc869d4bc9..0000000000 --- a/models/aether_lon-lat/transform_names.f90 +++ /dev/null @@ -1,134 +0,0 @@ -program transform_names - -! Test the functions that will go into model_mod for use by aether_to_dart -! and dart_to_aether to convert Aether field names to CF compliant DART names. -! - -! use netcdf -! use typesizes -use types_mod, only : MISSING_I - -! Why not? character (len=NF90_MAX_NAME) :: aether_name, dart_name -character (len=256) :: aether_name, dart_name - -aether_name = '' -read '(A)', aether_name - -dart_name = aeth_name_to_dart(aether_name) -print*, trim(dart_name), '||end' - -contains -!----------------------------------------------------------------------------- -! Translate an Aether field name (not CF-compliant) into a form filter likes. -! E.g. 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', -> -! 'Opos_Perp_Ion_Vel_Merid' -function aeth_name_to_dart(varname) - -! character(len=NF90_MAX_NAME), intent(in) :: varname -character(len=256), intent(in) :: varname - -! character(len=NF90_MAX_NAME) :: aeth -character(len=256) :: aeth -character(len=128) :: aeth_name_to_dart -character(len=32) :: parts(8), var_root -integer :: char_num, first, i_parts, aeth_len, end_str - -aeth = trim(varname) -aeth_len = len_trim(varname) -parts = '' - -! Look for the last ' '. The characters after that are the species. -! If there's no ' ', the whole string is the species. -char_num = 0 -char_num = scan(trim(aeth),' ',back=.true.) -print*,'species blank at ',char_num -var_root = aeth(char_num+1:aeth_len) -print*,'species var_root = ', var_root -end_str = char_num - -! purge_chars removes unwanted [()\] -! Remove blanks from front and end. -parts(1) = purge_chars( trim(var_root),')(\' ) -print*,'parts(1) = ',parts(1) - -! Tranform remaining pieces of varname into DART versions. -char_num = MISSING_I -first = 1 -i_parts = 2 -do - ! This returns the position of the first blank *within the substring* passed in. - char_num = scan(aeth(first:end_str),' ',back=.false.) - print*,'char_num, aeth substring = ',char_num, aeth(first:end_str),'||end' - if (char_num > 0 .and. first < aeth_len) then - parts(i_parts) = purge_chars(aeth(first:first+char_num-1), '.)(\' ) - - first = first + char_num - print*,'parts(i_parts), first, aeth_len = ' ,parts(i_parts), first , aeth_len - i_parts = i_parts + 1 - else - exit - endif -enddo - -! Construct the DART field name from the parts -aeth_name_to_dart = trim(parts(1)) -i_parts = 2 -do -if (trim(parts(i_parts)) /= '') then - aeth_name_to_dart = trim(aeth_name_to_dart)//'_'//trim(parts(i_parts)) - print*,'i_parts, aeth_name_to_dart = ' ,i_parts, aeth_name_to_dart - i_parts = i_parts + 1 -else - exit -endif -enddo - -end function aeth_name_to_dart - -!----------------------------------------------------------------- -! Replace undesirable characters with better. - -function purge_chars(ugly_string, chars) - -character (len=*), intent(in) :: ugly_string, chars -character (len=32) :: purge_chars, temp_str - -integer :: char_num, end_str, pm_num - -! Trim is not needed here -purge_chars = ugly_string -char_num = MISSING_I -do - ! Returns 0 if chars are not found - char_num = scan(trim(purge_chars),chars) - ! Need to change it to a char that won't be found by scan in the next iteration, - ! and can be easily removed. - print*,'purge_chars: purge_chars, char_num = ',trim(purge_chars),' ', char_num - if (char_num > 0) then - purge_chars(char_num:char_num) = ' ' - else - exit - endif -enddo - -! Replace + and - with pos and neg. Assume there's only 1. -temp_str = trim(adjustl(purge_chars)) -end_str = len_trim(temp_str) -pm_num = scan(trim(temp_str),'+-',back=.false.) -if (pm_num == 0) then - purge_chars = trim(temp_str) -else - if (temp_str(pm_num:pm_num) == '+') then - purge_chars = temp_str(1:pm_num-1)//'pos' - else if (temp_str(pm_num:pm_num) == '-') then - purge_chars = temp_str(1:pm_num-1)//'neg' - endif - if (pm_num+1 <= end_str) & - purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) -endif - - -end function purge_chars - -end program - diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index fdfca50336..88a0a92210 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -40,7 +40,7 @@ &filter_nml single_file_in = .false., input_state_files = '' - input_state_file_list = 'restart_p_files.txt', 'secondary_files.txt' + input_state_file_list = 'filter_inputs.txt' init_time_days = 153131, init_time_seconds = 0, perturb_from_single_instance = .true., @@ -50,7 +50,7 @@ single_file_out = .false., output_state_files = '' - output_state_file_list = 'out_restart_p_files.txt', 'out_secondary_files.txt' + output_state_file_list = 'filter_outputs.txt' output_interval = 1, output_members = .true. num_output_state_members = 0, @@ -170,7 +170,14 @@ time_step_seconds = 3600 debug = 10 / -! >>> Don't code these until we get new CF-compliant field names from Aaron. <<< +! The most CF-compliant field names we'll get from Aaron are transformed for DART into: + velocity_east (U component of neutral wind) + Opos_velocity_parallel_east + Opos_velocity_parallel_north + Opos_velocity_parallel_up + Opos_velocity_perp_east + Opos_velocity_perp_north + Opos_velocity_perp_up ! Other neutrals from restart files, which Aaron identified as important: Zonal\ Wind Meridional\ Wind @@ -187,22 +194,22 @@ filter_io_root = 'filter_input' variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', '10000.0', 'neutrals', 'UPDATE', - 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' 'NA', 'NA', 'neutrals', 'UPDATE', + 'velocity_east', 'QTY_U_WIND_COMPONENT' '1000.0', 'NA', 'neutrals', 'UPDATE', 'O+', - 'QTY_DENSITY_ION_OP', '0.', 'NA', 'ions', 'UPDATE' + 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' 'Temperature\ \(O+\)', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'velocity_parallel_east\ \(O+\)', 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'velocity_parallel_north\ \(O+\)', 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'velocity_parallel_up\ \(O+\)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'velocity_perp_east\ \(O+\)', 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'velocity_perp_north\ \(O+\)', 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'velocity_perp_up\ \(O+\)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' debug = 5 / @@ -212,22 +219,22 @@ filter_io_root = 'filter_output', variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'Zonal\ Wind', 'QTY_VERTICAL_VELOCITY' '1000.0', 'NA', 'neutrals', 'UPDATE', - 'O+', + 'velocity_east' 'QTY_U_WIND_COMPONENT' '1000.0', 'NA', 'neutrals', 'UPDATE', + 'O+', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' - 'Temperature\ \(O+\)', + 'Temperature (O+)', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'velocity_parallel_east (O+)', 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'velocity_parallel_north (O+)', 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Parallel\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'velocity_parallel_up (O+)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Zonal\)\ \(O+\)', + 'velocity_perp_east (O+)', 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Meridional\)\ \(O+\)', + 'velocity_perp_north (O+)', 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'Perp.\ Ion\ Velocity\ \(Vertical\)\ \(O+\)', + 'velocity_perp_up (O+)', 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' debug = 5 / From 58f3c97602356be2fea94adc5569bf905a8f41fc Mon Sep 17 00:00:00 2001 From: Moha El Gharamti Date: Fri, 26 Jan 2024 10:37:16 -0700 Subject: [PATCH 060/124] Compression that supports staggered grids Changes made to trans_mit_dart: - trans_mit_dart now uses separate compression dimensions for U and V - T, SAL and other tracers still use original compression - Eta's compression is done through the T (or SAL) surface layer to avoid any zero pressure (height) issues - The tracers after DART are written into MITgcm's pickup files Changes to model_mod: - Getting compressed state index now directly uses comp_inds from the restart files --- models/MITgcm_ocean/model_mod.f90 | 124 ++--- models/MITgcm_ocean/trans_mitdart_mod.f90 | 532 +++++++++++++++++----- 2 files changed, 495 insertions(+), 161 deletions(-) diff --git a/models/MITgcm_ocean/model_mod.f90 b/models/MITgcm_ocean/model_mod.f90 index 3e4d763a1d..a62efe8346 100644 --- a/models/MITgcm_ocean/model_mod.f90 +++ b/models/MITgcm_ocean/model_mod.f90 @@ -256,13 +256,17 @@ module model_mod ! standard MITgcm namelist and filled in here. integer :: Nx=-1, Ny=-1, Nz=-1 ! grid counts for each field -integer :: comp3d=-1 ! size of commpressed variables +integer :: comp2d = -1, comp3d=-1, comp3dU = -1, comp3dV = -1 ! size of commpressed variables ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) real(r4), allocatable :: XC_sq(:), YC_sq(:), XG_sq(:), YG_sq(:) real(r8), allocatable :: ZC_sq(:) +integer, allocatable :: Xc_Ti(:), Yc_Ti(:), Zc_Ti(:) +integer, allocatable :: Xc_Ui(:), Yc_Ui(:), Zc_Ui(:) +integer, allocatable :: Xc_Vi(:), Yc_Vi(:), Zc_Vi(:) + real(r8) :: ocean_dynamics_timestep = 900.0_r4 integer :: timestepcount = 0 type(time_type) :: model_time, model_timestep @@ -295,7 +299,7 @@ module model_mod logical :: go_to_dart = .false. logical :: do_bgc = .false. logical :: log_transform = .false. -logical :: compress = .false. +logical :: compress = .false. namelist /trans_mitdart_nml/ go_to_dart, do_bgc, log_transform, compress @@ -535,8 +539,11 @@ subroutine static_init_model() if (compress) then ! read in compressed coordinates - ncid = nc_open_file_readonly(model_shape_file) - comp3d = nc_get_dimension_size(ncid, 'comp3d', 'static_init_model', model_shape_file) + ncid = nc_open_file_readonly(model_shape_file) + comp2d = nc_get_dimension_size(ncid, 'comp2d' , 'static_init_model', model_shape_file) + comp3d = nc_get_dimension_size(ncid, 'comp3d' , 'static_init_model', model_shape_file) + comp3dU = nc_get_dimension_size(ncid, 'comp3dU', 'static_init_model', model_shape_file) + comp3dV = nc_get_dimension_size(ncid, 'comp3dV', 'static_init_model', model_shape_file) allocate(XC_sq(comp3d)) allocate(YC_sq(comp3d)) @@ -545,6 +552,18 @@ subroutine static_init_model() allocate(XG_sq(comp3d)) allocate(YG_sq(comp3d)) + allocate(Xc_Ti(comp3d)) + allocate(Yc_Ti(comp3d)) + allocate(Zc_Ti(comp3d)) + + allocate(Xc_Ui(comp3dU)) + allocate(Yc_Ui(comp3dU)) + allocate(Zc_Ui(comp3dU)) + + allocate(Xc_Vi(comp3dV)) + allocate(Yc_Vi(comp3dV)) + allocate(Zc_Vi(comp3dV)) + call nc_get_variable(ncid, 'XCcomp', XC_sq) call nc_get_variable(ncid, 'YCcomp', YC_sq) call nc_get_variable(ncid, 'ZCcomp', ZC_sq) @@ -552,6 +571,18 @@ subroutine static_init_model() call nc_get_variable(ncid, 'XGcomp', XG_sq) call nc_get_variable(ncid, 'YGcomp', YG_sq) + call nc_get_variable(ncid, 'Xcomp_ind', Xc_Ti) + call nc_get_variable(ncid, 'Ycomp_ind', Yc_Ti) + call nc_get_variable(ncid, 'Zcomp_ind', Zc_Ti) + + call nc_get_variable(ncid, 'Xcomp_indU', Xc_Ui) + call nc_get_variable(ncid, 'Ycomp_indU', Yc_Ui) + call nc_get_variable(ncid, 'Zcomp_indU', Zc_Ui) + + call nc_get_variable(ncid, 'Xcomp_indV', Xc_Vi) + call nc_get_variable(ncid, 'Ycomp_indV', Yc_Vi) + call nc_get_variable(ncid, 'Zcomp_indV', Zc_Vi) + call nc_close_file(ncid) endif @@ -991,70 +1022,49 @@ function get_compressed_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) integer, intent(in) :: dom_id, var_id integer(i8) :: get_compressed_dart_vector_index -real(r4) :: lon, lat -real(r8) :: depth -integer :: i ! loop counter -logical :: lon_found, lat_found, depth_found -integer :: qty - +integer :: i ! loop counter +integer :: qty integer(i8) :: offset -logical :: is_2d offset = get_index_start(dom_id, var_id) -lon = XC(iloc) !lon -lat = YC(jloc) !lat -depth = ZC(kloc) !depth - qty = get_kind_index(dom_id, var_id) -if (qty == QTY_U_CURRENT_COMPONENT) lon = XG(iloc) -if (qty == QTY_V_CURRENT_COMPONENT) lat = YG(jloc) - -is_2d = .false. - -if (qty == QTY_SEA_SURFACE_HEIGHT .or. qty == QTY_SURFACE_CHLOROPHYLL ) then - depth = ZC(1) - is_2d = .true. -endif get_compressed_dart_vector_index = -1 -! Find the index in the compressed state -! HK you could read in {X,Y,Z}comp_ind if you did not want to do this search -do i=1, comp3d - lon_found = .false. - lat_found = .false. - depth_found = .false. - - if (qty == QTY_U_CURRENT_COMPONENT) then - if ( XG_sq(i) == lon ) then - lon_found = .true. - endif - else - if ( XC_sq(i) == lon ) then - lon_found = .true. +! MEG: Using the already established compressed indices +! +! 2D compressed variables +if (qty == QTY_SEA_SURFACE_HEIGHT .or. qty == QTY_SURFACE_CHLOROPHYLL ) then + do i = 1, comp2d + if (Xc_Ti(i) == iloc .and. Yc_Ti(i) == jloc .and. Zc_Ti(i) == 1) then + get_compressed_dart_vector_index = offset + i - 1 endif - endif + enddo + return +endif - if (qty == QTY_V_CURRENT_COMPONENT) then - if (YG_sq(i) == lat) then - lat_found = .true. - endif - else - if ( YC_sq(i) == lat ) then - lat_found = .true. - endif - endif +! 3D compressed variables +if (qty == QTY_U_CURRENT_COMPONENT) then + do i = 1, comp3dU + if (Xc_Ui(i) == iloc .and. Yc_Ui(i) == jloc .and. Zc_Ui(i) == kloc) then + get_compressed_dart_vector_index = offset + i - 1 + endif + enddo +elseif (qty == QTY_V_CURRENT_COMPONENT) then + do i = 1, comp3dV + if (Xc_Vi(i) == iloc .and. Yc_Vi(i) == jloc .and. Zc_Vi(i) == kloc) then + get_compressed_dart_vector_index = offset + i - 1 + endif + enddo +else + do i = 1, comp3d + if (Xc_Ti(i) == iloc .and. Yc_Ti(i) == jloc .and. Zc_Ti(i) == kloc) then + get_compressed_dart_vector_index = offset + i - 1 + endif + enddo +endif - if ( ZC_sq(i) == depth ) then - depth_found = .true. - endif - - if (lon_found .and. lat_found .and. depth_found )then - get_compressed_dart_vector_index = offset + i - 1 - return - endif -enddo end function get_compressed_dart_vector_index diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index 2a7838e567..b9302a4692 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -79,12 +79,21 @@ module trans_mitdart_mod ! standard MITgcm namelist and filled in here. integer :: Nx=-1, Ny=-1, Nz=-1 ! grid counts for each field -integer :: ncomp2=-1, ncomp3=-1 ! length of compressed dim +integer :: ncomp2 = -1 ! length of 2D compressed dim +integer :: ncomp3 = -1, ncomp3U = -1, ncomp3V = -1 ! length of 3D compressed dim + +integer, parameter :: MITgcm_3D_FIELD = 1 +integer, parameter :: MITgcm_3D_FIELD_U = 2 +integer, parameter :: MITgcm_3D_FIELD_V = 3 ! locations of cell centers (C) and edges (G) for each axis. real(r8), allocatable :: XC(:), XG(:), YC(:), YG(:), ZC(:), ZG(:) real(r8), allocatable :: XCcomp(:), XGcomp(:), YCcomp(:), YGcomp(:), ZCcomp(:), ZGcomp(:) -integer, allocatable :: Xcomp_ind(:), Ycomp_ind(:), Zcomp_ind(:) !HK are the staggered grids compressed the same? + +integer, allocatable :: Xcomp_ind(:), Ycomp_ind(:), Zcomp_ind(:) !HK are the staggered grids compressed the same? +!MEG: For staggered grids +integer, allocatable :: Xcomp_indU(:), Ycomp_indU(:), Zcomp_indU(:) +integer, allocatable :: Xcomp_indV(:), Ycomp_indV(:), Zcomp_indV(:) ! 3D variables, 3 grids: ! @@ -92,6 +101,9 @@ module trans_mitdart_mod ! XC, YC, ZG 2 UVEL ! XC, YG, ZC 3 VVEL +! MEG: For compression, especially if we're doing Arakawa C-grid, +! we will need 3 different compressions for the above variables + ! 2D variables, 1 grid: ! ! YC, XC ETA, CHL @@ -238,10 +250,12 @@ subroutine mit2dart() ! for the dimensions and coordinate variables integer :: XGDimID, XCDimID, YGDimID, YCDimID, ZGDimID, ZCDimID integer :: XGVarID, XCVarID, YGVarID, YCVarID, ZGVarID, ZCVarID -integer :: comp2ID, comp3ID ! compressed dim +integer :: comp2ID, comp3ID, comp3UD, comp3VD ! compressed dim integer :: XGcompVarID, XCcompVarID, YGcompVarID, YCcompVarID, ZGcompVarID, ZCcompVarID integer :: XindID, YindID, ZindID -integer :: all_dimids(7) ! store the 7 dimension ids that are used +integer :: XindUD, YindUD, ZindUD +integer :: XindVD, YindVD, ZindVD +integer :: all_dimids(9) ! store the 9 dimension ids that are used ! for the prognostic variables integer :: SVarID, TVarID, UVarID, VVarID, EtaVarID @@ -264,17 +278,33 @@ subroutine mit2dart() call check(nf90_def_dim(ncid=ncid, name="XG", len = Nx, dimid = XGDimID)) call check(nf90_def_dim(ncid=ncid, name="YG", len = Ny, dimid = YGDimID)) +print *, '' + if (compress) then ncomp2 = get_compressed_size_2d() - ncomp3 = get_compressed_size_3d() - call check(nf90_def_dim(ncid=ncid, name="comp2d", len = ncomp2, dimid = comp2ID)) - call check(nf90_def_dim(ncid=ncid, name="comp3d", len = ncomp3, dimid = comp3ID)) + + write(*, '(A, I12, A, I8)') '2D: ', Nx*Ny, ', COMP2D: ', ncomp2 + + ncomp3 = get_compressed_size_3d(MITgcm_3D_FIELD) + ncomp3U = get_compressed_size_3d(MITgcm_3D_FIELD_U) + ncomp3V = get_compressed_size_3d(MITgcm_3D_FIELD_V) + + write(*, '(A, I12, A, 3I8)') '3D: ', Nx*Ny*Nz, ', COMP3D [T-S, U, V]: ', ncomp3, ncomp3U, ncomp3V + + ! Put the compressed dimensions in the restart file + call check(nf90_def_dim(ncid=ncid, name="comp2d", len = ncomp2, dimid = comp2ID)) + call check(nf90_def_dim(ncid=ncid, name="comp3d", len = ncomp3, dimid = comp3ID)) + call check(nf90_def_dim(ncid=ncid, name="comp3dU", len = ncomp3U, dimid = comp3UD)) + call check(nf90_def_dim(ncid=ncid, name="comp3dV", len = ncomp3V, dimid = comp3VD)) else comp2ID = -1 comp3ID = -1 endif -all_dimids = (/XCDimID, YCDimID, ZCDimID, XGDimID, YGDimID, comp2ID, comp3ID/) +all_dimids = (/XCDimID, YCDimID, ZCDimID, XGDimID, YGDimID, & + comp2ID, comp3ID, comp3UD, comp3VD/) + +print *, '' ! Create the (empty) Coordinate Variables and the Attributes @@ -328,25 +358,34 @@ subroutine mit2dart() call check(nf90_def_var(ncid,name="YGcomp",xtype=nf90_real,dimids=comp3ID,varid=YGcompVarID)) call check(nf90_def_var(ncid,name="YCcomp",xtype=nf90_real,dimids=comp3ID,varid=YCcompVarID)) call check(nf90_def_var(ncid,name="ZCcomp",xtype=nf90_double,dimids=comp3ID,varid=ZCcompVarID)) + call check(nf90_def_var(ncid,name="Xcomp_ind",xtype=nf90_int,dimids=comp3ID,varid=XindID)) call check(nf90_def_var(ncid,name="Ycomp_ind",xtype=nf90_int,dimids=comp3ID,varid=YindID)) call check(nf90_def_var(ncid,name="Zcomp_ind",xtype=nf90_int,dimids=comp3ID,varid=ZindID)) + + call check(nf90_def_var(ncid,name="Xcomp_indU",xtype=nf90_int,dimids=comp3UD,varid=XindUD)) + call check(nf90_def_var(ncid,name="Ycomp_indU",xtype=nf90_int,dimids=comp3UD,varid=YindUD)) + call check(nf90_def_var(ncid,name="Zcomp_indU",xtype=nf90_int,dimids=comp3UD,varid=ZindUD)) + + call check(nf90_def_var(ncid,name="Xcomp_indV",xtype=nf90_int,dimids=comp3VD,varid=XindVD)) + call check(nf90_def_var(ncid,name="Ycomp_indV",xtype=nf90_int,dimids=comp3VD,varid=YindVD)) + call check(nf90_def_var(ncid,name="Zcomp_indV",xtype=nf90_int,dimids=comp3VD,varid=ZindVD)) endif ! The size of these variables will depend on the compression ! Create the (empty) Prognostic Variables and the Attributes -SVarID = define_variable(ncid,"PSAL", nf90_real, all_dimids) +SVarID = define_variable(ncid,"PSAL", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, SVarID, "potential salinity", "psu", "practical salinity units") -TVarID = define_variable(ncid,"PTMP", nf90_real, all_dimids) +TVarID = define_variable(ncid,"PTMP", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, TVarID, "Potential Temperature", "C", "degrees celsius") -UVarID = define_variable(ncid,"UVEL", nf90_real, all_dimids) +UVarID = define_variable(ncid,"UVEL", nf90_real, all_dimids, MITgcm_3D_FIELD_U) call add_attributes_to_variable(ncid, UVarID, "Zonal Velocity", "m/s", "meters per second") -VVarID = define_variable(ncid,"VVEL", nf90_real, all_dimids) +VVarID = define_variable(ncid,"VVEL", nf90_real, all_dimids, MITgcm_3D_FIELD_V) call add_attributes_to_variable(ncid, VVarID, "Meridional Velocity", "m/s", "meters per second") EtaVarID = define_variable_2d(ncid,"ETA", nf90_real, all_dimids) @@ -356,39 +395,39 @@ subroutine mit2dart() if (do_bgc) then ! 1. BLING tracer: nitrate NO3 - no3_varid = define_variable(ncid,"NO3", nf90_real, all_dimids) + no3_varid = define_variable(ncid,"NO3", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, no3_varid, "Nitrate", "mol N/m3", "moles Nitrogen per cubic meters") ! 2. BLING tracer: phosphate PO4 - po4_varid = define_variable(ncid,"PO4", nf90_real, all_dimids) + po4_varid = define_variable(ncid,"PO4", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, po4_varid, "Phosphate", "mol P/m3", "moles Phosphorus per cubic meters") ! 3. BLING tracer: oxygen O2 - o2_varid = define_variable(ncid,"O2", nf90_real, all_dimids) + o2_varid = define_variable(ncid,"O2", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, o2_varid, "Dissolved Oxygen", "mol O/m3", "moles Oxygen per cubic meters") ! 4. BLING tracer: phytoplankton PHY - phy_varid = define_variable(ncid,"PHY", nf90_real, all_dimids) + phy_varid = define_variable(ncid,"PHY", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, phy_varid, "Phytoplankton Biomass", "mol C/m3", "moles Carbon per cubic meters") ! 5. BLING tracer: alkalinity ALK - alk_varid = define_variable(ncid,"ALK", nf90_real, all_dimids) + alk_varid = define_variable(ncid,"ALK", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, alk_varid, "Alkalinity", "mol eq/m3", "moles equivalent per cubic meters") ! 6. BLING tracer: dissolved inorganic carbon DIC - dic_varid = define_variable(ncid,"DIC", nf90_real, all_dimids) + dic_varid = define_variable(ncid,"DIC", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, dic_varid, "Dissolved Inorganic Carbon", "mol C/m3", "moles Carbon per cubic meters") ! 7. BLING tracer: dissolved organic phosphorus DOP - dop_varid = define_variable(ncid,"DOP", nf90_real, all_dimids) + dop_varid = define_variable(ncid,"DOP", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, dop_varid, "Dissolved Organic Phosphorus", "mol P/m3", "moles Phosphorus per cubic meters") ! 8. BLING tracer: dissolved organic nitrogen DON - don_varid = define_variable(ncid,"DON", nf90_real, all_dimids) + don_varid = define_variable(ncid,"DON", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, don_varid, "Dissolved Organic Nitrogen", "mol N/m3", "moles Nitrogen per cubic meters") ! 9. BLING tracer: dissolved inorganic iron FET - fet_varid = define_variable(ncid,"FET", nf90_real, all_dimids) + fet_varid = define_variable(ncid,"FET", nf90_real, all_dimids, MITgcm_3D_FIELD) call add_attributes_to_variable(ncid, fet_varid, "Dissolved Inorganic Iron", "mol Fe/m3", "moles Iron per cubic meters") ! 10. BLING tracer: Surface Chlorophyl CHL @@ -418,28 +457,49 @@ subroutine mit2dart() allocate(Xcomp_ind(ncomp3)) allocate(Ycomp_ind(ncomp3)) allocate(Zcomp_ind(ncomp3)) + + allocate(Xcomp_indU(ncomp3U)) + allocate(Ycomp_indU(ncomp3U)) + allocate(Zcomp_indU(ncomp3U)) + + allocate(Xcomp_indV(ncomp3V)) + allocate(Ycomp_indV(ncomp3V)) + allocate(Zcomp_indV(ncomp3V)) + call fill_compressed_coords() + call check(nf90_put_var(ncid, XGcompVarID, XGcomp )) call check(nf90_put_var(ncid, XCcompVarID, XCcomp )) call check(nf90_put_var(ncid, YGcompVarID, YGcomp )) call check(nf90_put_var(ncid, YCcompVarID, YCcomp )) call check(nf90_put_var(ncid, ZCcompVarID, ZCcomp )) + call check(nf90_put_var(ncid, XindID, Xcomp_ind )) call check(nf90_put_var(ncid, YindID, Ycomp_ind )) call check(nf90_put_var(ncid, ZindID, Zcomp_ind )) + + call check(nf90_put_var(ncid, XindUD, Xcomp_indU )) + call check(nf90_put_var(ncid, YindUD, Ycomp_indU )) + call check(nf90_put_var(ncid, ZindUD, Zcomp_indU )) + + call check(nf90_put_var(ncid, XindVD, Xcomp_indV )) + call check(nf90_put_var(ncid, YindVD, Ycomp_indV )) + call check(nf90_put_var(ncid, ZindVD, Zcomp_indV )) endif ! Fill the netcdf variables -call from_mit_to_netcdf_3d('PSAL.data', ncid, SVarID) -call from_mit_to_netcdf_3d('PTMP.data', ncid, TVarID) -call from_mit_to_netcdf_3d('UVEL.data', ncid, UVarID) -call from_mit_to_netcdf_3d('VVEL.data', ncid, VVarID) -call from_mit_to_netcdf_2d('ETA.data', ncid, EtaVarID) +call from_mit_to_netcdf_3d('PSAL.data', ncid, SVarID, MITgcm_3D_FIELD) +call from_mit_to_netcdf_3d('PTMP.data', ncid, TVarID, MITgcm_3D_FIELD) +call from_mit_to_netcdf_3d('UVEL.data', ncid, UVarID, MITgcm_3D_FIELD_U) +call from_mit_to_netcdf_3d('VVEL.data', ncid, VVarID, MITgcm_3D_FIELD_V) +call from_mit_to_netcdf_2d('ETA.data' , ncid, EtaVarID) + +print *, 'Done writing physical variables' if (do_bgc) then call from_mit_to_netcdf_tracer_3d('NO3.data', ncid, no3_varid) call from_mit_to_netcdf_tracer_3d('PO4.data', ncid, po4_varid) - call from_mit_to_netcdf_tracer_3d('O2.data', ncid, o2_varid) + call from_mit_to_netcdf_tracer_3d('O2.data' , ncid, o2_varid) call from_mit_to_netcdf_tracer_3d('PHY.data', ncid, phy_varid) call from_mit_to_netcdf_tracer_3d('ALK.data', ncid, alk_varid) call from_mit_to_netcdf_tracer_3d('DIC.data', ncid, dic_varid) @@ -447,6 +507,8 @@ subroutine mit2dart() call from_mit_to_netcdf_tracer_3d('DON.data', ncid, don_varid) call from_mit_to_netcdf_tracer_3d('FET.data', ncid, fet_varid) call from_mit_to_netcdf_tracer_2d('CHL.data', ncid, chl_varid) + + print *, 'Done writing biogeochemical variables' endif call check(nf90_close(ncid)) @@ -465,35 +527,57 @@ subroutine dart2mit() call check(nf90_open("INPUT.nc",NF90_NOWRITE,ncid)) if (compress) then - ncomp3 = nc_get_dimension_size(ncid,'comp3d') ncomp2 = nc_get_dimension_size(ncid,'comp2d') + + ncomp3 = nc_get_dimension_size(ncid,'comp3d') + ncomp3U = nc_get_dimension_size(ncid,'comp3dU') + ncomp3V = nc_get_dimension_size(ncid,'comp3dV') + allocate(Xcomp_ind(ncomp3)) allocate(Ycomp_ind(ncomp3)) allocate(Zcomp_ind(ncomp3)) + + allocate(Xcomp_indU(ncomp3U)) + allocate(Ycomp_indU(ncomp3U)) + allocate(Zcomp_indU(ncomp3U)) + + allocate(Xcomp_indV(ncomp3V)) + allocate(Ycomp_indV(ncomp3V)) + allocate(Zcomp_indV(ncomp3V)) + call nc_get_variable(ncid, 'Xcomp_ind', Xcomp_ind) call nc_get_variable(ncid, 'Ycomp_ind', Ycomp_ind) call nc_get_variable(ncid, 'Zcomp_ind', Zcomp_ind) + + call nc_get_variable(ncid, 'Xcomp_indU', Xcomp_indU) + call nc_get_variable(ncid, 'Ycomp_indU', Ycomp_indU) + call nc_get_variable(ncid, 'Zcomp_indU', Zcomp_indU) + + call nc_get_variable(ncid, 'Xcomp_indV', Xcomp_indV) + call nc_get_variable(ncid, 'Ycomp_indV', Ycomp_indV) + call nc_get_variable(ncid, 'Zcomp_indV', Zcomp_indV) endif !Fill the data -call from_netcdf_to_mit_3d(ncid, 'PSAL') -call from_netcdf_to_mit_3d(ncid, 'PTMP') -call from_netcdf_to_mit_3d(ncid, 'UVEL') -call from_netcdf_to_mit_3d(ncid, 'VVEL') -call from_netcdf_to_mit_2d(ncid, 'ETA') +call from_netcdf_to_mit_3d_pickup(ncid, 'UVEL', 1, MITgcm_3D_FIELD_U) +call from_netcdf_to_mit_3d_pickup(ncid, 'VVEL', 2, MITgcm_3D_FIELD_V) +call from_netcdf_to_mit_3d_pickup(ncid, 'PTMP', 3, MITgcm_3D_FIELD) +call from_netcdf_to_mit_3d_pickup(ncid, 'PSAL', 4, MITgcm_3D_FIELD) +call from_netcdf_to_mit_2d_pickup(ncid, 'ETA') +print *, 'Done writing physical variables into model binary files' if (do_bgc) then - call from_netcdf_to_mit_tracer(ncid, 'NO3') - call from_netcdf_to_mit_tracer(ncid, 'PO4') - call from_netcdf_to_mit_tracer(ncid, 'O2') - call from_netcdf_to_mit_tracer(ncid, 'PHY') - call from_netcdf_to_mit_tracer(ncid, 'ALK') - call from_netcdf_to_mit_tracer(ncid, 'DIC') - call from_netcdf_to_mit_tracer(ncid, 'DOP') - call from_netcdf_to_mit_tracer(ncid, 'DON') - call from_netcdf_to_mit_tracer(ncid, 'FET') - if (output_chl_data) call from_netcdf_to_mit_tracer_chl(ncid, 'CHL') + call from_netcdf_to_mit_tracer_pickup(ncid, 'DIC', 1) + call from_netcdf_to_mit_tracer_pickup(ncid, 'ALK', 2) + call from_netcdf_to_mit_tracer_pickup(ncid, 'O2' , 3) + call from_netcdf_to_mit_tracer_pickup(ncid, 'NO3', 4) + call from_netcdf_to_mit_tracer_pickup(ncid, 'PO4', 5) + call from_netcdf_to_mit_tracer_pickup(ncid, 'FET', 6) + call from_netcdf_to_mit_tracer_pickup(ncid, 'DON', 7) + call from_netcdf_to_mit_tracer_pickup(ncid, 'DOP', 8) + call from_netcdf_to_mit_tracer_pickup(ncid, 'PHY', 9) + print *, 'Done writing biogeochemical variables into model binary files' endif call check( NF90_CLOSE(ncid) ) @@ -519,22 +603,31 @@ end subroutine check !=============================================================================== ! 3D variable -function define_variable(ncid, name, nc_type, all_dimids) result(varid) +function define_variable(ncid, VARname, nc_type, all_dimids, field) result(varid) integer, intent(in) :: ncid -character(len=*), intent(in) :: name ! variable name +character(len=*), intent(in) :: VARname ! variable name integer, intent(in) :: nc_type -integer, intent(in) :: all_dimids(7) ! possible dimension ids +integer, intent(in) :: all_dimids(9) ! possible dimension ids +integer, intent(in) :: field integer :: varid ! netcdf variable id integer :: dimids(3) if (compress) then - call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & - dimids=all_dimids(7),varid=varid)) + if (field == MITgcm_3D_FIELD) then + call check(nf90_def_var(ncid=ncid, name=VARname, xtype=nc_type, & + dimids=all_dimids(7),varid=varid)) + elseif (field == MITgcm_3D_FIELD_U) then + call check(nf90_def_var(ncid=ncid, name=VARname, xtype=nc_type, & + dimids=all_dimids(8),varid=varid)) + elseif (field == MITgcm_3D_FIELD_V) then + call check(nf90_def_var(ncid=ncid, name=VARname, xtype=nc_type, & + dimids=all_dimids(9),varid=varid)) + endif else - dimids = which_dims(name, all_dimids) - call check(nf90_def_var(ncid=ncid, name=name, xtype=nc_type, & + dimids = which_dims(VARname, all_dimids) + call check(nf90_def_var(ncid=ncid, name=VARname, xtype=nc_type, & dimids=dimids, varid=varid)) endif @@ -543,21 +636,21 @@ end function define_variable !------------------------------------------------------------------ ! For the non-compressed variables, X,Y,Z dimesnions vary ! depending on the variable -function which_dims(name, all_dimids) result(dimids) +function which_dims(VARname, all_dimids) result(dimids) -character(len=*), intent(in) :: name ! variable name -integer, intent(in) :: all_dimids(7) +character(len=*), intent(in) :: VARname ! variable name +integer, intent(in) :: all_dimids(9) integer :: dimids(3) ! 3D variables, 3 grids: ! XC, YC, ZC 1 PSAL, PTMP, NO3, PO4, O2, PHY, ALK, DIC, DOP, DON, FET ! XG, YC, ZC 2 UVEL ! XC, YG, ZC 3 VVEL -if (name=='UVEL') then +if (VARname == 'UVEL') then dimids = (/all_dimids(4),all_dimids(2),all_dimids(3)/) return endif -if (name=='VVEL') then +if (VARname == 'VVEL') then dimids = (/all_dimids(1),all_dimids(5),all_dimids(3)/) return endif @@ -573,7 +666,7 @@ function define_variable_2d(ncid, name, nc_type, all_dimids) result(varid) integer, intent(in) :: ncid character(len=*), intent(in) :: name ! variable name integer, intent(in) :: nc_type -integer, intent(in) :: all_dimids(7) +integer, intent(in) :: all_dimids(9) integer :: varid ! netcdf variable id ! 2D variables, 1 grid: @@ -604,10 +697,10 @@ subroutine add_attributes_to_variable(ncid, varid, long_name, units, units_long_ end subroutine !------------------------------------------------------------------ -subroutine from_mit_to_netcdf_3d(mitfile, ncid, varid) +subroutine from_mit_to_netcdf_3d(mitfile, ncid, varid, field) character(len=*), intent(in) :: mitfile -integer, intent(in) :: ncid, varid ! which file, which variable +integer, intent(in) :: ncid, varid, field ! which file, which variable, grid type integer :: iunit real(r4) :: var_data(Nx,Ny,Nz) @@ -622,7 +715,7 @@ subroutine from_mit_to_netcdf_3d(mitfile, ncid, varid) where (var_data == binary_fill) var_data = FVAL !HK do we also need a check for nans here? if (compress) then - call write_compressed(ncid, varid, var_data) + call write_compressed(ncid, varid, var_data, field) else call check(nf90_put_var(ncid,varid,var_data)) endif @@ -636,7 +729,7 @@ subroutine from_mit_to_netcdf_2d(mitfile, ncid, varid) integer, intent(in) :: ncid, varid ! which file, which variable integer :: iunit -real(r4) :: var_data(Nx,Ny) +real(r4) :: var_data(Nx,Ny), var_T_data(Nx,Ny,Nz) iunit = get_unit() ! HK are the mit files big endian by default? @@ -645,7 +738,13 @@ subroutine from_mit_to_netcdf_2d(mitfile, ncid, varid) read(iunit,rec=1) var_data close(iunit) -where (var_data == binary_fill) var_data = FVAL !HK do we also need a check for nans here? +! Manually get PTMP surface layer +open(iunit, file='PTMP.data', form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') +read(iunit,rec=1) var_T_data +close(iunit) + +where (var_T_data(:,:,1) == binary_fill) var_data = FVAL !HK do we also need a check for nans here? if (compress) then call write_compressed(ncid, varid, var_data) @@ -698,7 +797,7 @@ subroutine from_mit_to_netcdf_tracer_3d(mitfile, ncid, varid) endif if (compress) then - call write_compressed(ncid, varid, var_data) + call write_compressed(ncid, varid, var_data, MITgcm_3D_FIELD) else call check(nf90_put_var(ncid,varid,var_data)) endif @@ -787,12 +886,12 @@ subroutine from_netcdf_to_mit_2d(ncid, name) end subroutine from_netcdf_to_mit_2d !------------------------------------------------------------------ -subroutine from_netcdf_to_mit_3d(ncid, name) +subroutine from_netcdf_to_mit_3d(ncid, name, field) integer, intent(in) :: ncid ! which file, character(len=*), intent(in) :: name ! which variable -integer :: iunit +integer :: iunit, field real(r4) :: var(Nx,Ny,Nz) integer :: varid real(r4) :: local_fval @@ -803,7 +902,7 @@ subroutine from_netcdf_to_mit_3d(ncid, name) var(:,:,:) = local_fval if (compress) then - call read_compressed(ncid, varid, var) + call read_compressed(ncid, varid, var, field) else call check(nf90_get_var(ncid,varid,var)) endif @@ -818,6 +917,86 @@ subroutine from_netcdf_to_mit_3d(ncid, name) end subroutine from_netcdf_to_mit_3d +!------------------------------------------------------------------ +subroutine from_netcdf_to_mit_2d_pickup(ncid, name) + +integer, intent(in) :: ncid ! which file, +character(len=*), intent(in) :: name ! which variable + +integer :: iunit +real(r4) :: var(Nx,Ny) +real(r8) :: var8(Nx,Ny) +integer :: varid +real(r4) :: local_fval + +call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) + +! initialize var to netcdf fill value +var(:,:) = local_fval + +if (compress) then + call read_compressed(ncid, varid, var) +else + call check(nf90_get_var(ncid,varid,var)) +endif + +where (var == local_fval) var = binary_fill +var8 = var + +iunit = get_unit() +open(iunit, file='PICKUP.OUTPUT', form="UNFORMATTED", status='UNKNOWN', & + access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') +if (do_bgc) then + write(iunit,rec=401) var8 +else + write(iunit,rec=351) var8 +endif +close(iunit) + +end subroutine from_netcdf_to_mit_2d_pickup + +!------------------------------------------------------------------ +subroutine from_netcdf_to_mit_3d_pickup(ncid, name, lev, field) + +integer, intent(in) :: ncid ! which file, +character(len=*), intent(in) :: name ! which variable + +integer :: iunit, lev, field +real(r4) :: var(Nx,Ny,Nz) +real(r8) :: var8(Nx,Ny,Nz) +integer :: varid, i +real(r4) :: local_fval +integer :: LB, RB, RF + +call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) + +! initialize var to netcdf fill value +var(:,:,:) = local_fval + +if (compress) then + call read_compressed(ncid, varid, var, field) +else + call check(nf90_get_var(ncid,varid,var)) +endif + +where (var == local_fval) var = binary_fill +var8 = var + +iunit = get_unit() +open(iunit, file='PICKUP.OUTPUT', form="UNFORMATTED", status='UNKNOWN', & + access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') + +LB = Nz * (lev-1) + 1 +RB = Nx * lev +RF = Nz * (lev-1) +do i = LB, RB + write(iunit,rec=i) var8(:, :, i - RF) +enddo +close(iunit) + +end subroutine from_netcdf_to_mit_3d_pickup !------------------------------------------------------------------ subroutine from_netcdf_to_mit_tracer(ncid, name) @@ -836,7 +1015,7 @@ subroutine from_netcdf_to_mit_tracer(ncid, name) var(:,:,:) = local_fval if (compress) then - call read_compressed(ncid, varid, var) + call read_compressed(ncid, varid, var, MITgcm_3D_FIELD) else call check(nf90_get_var(ncid,varid,var)) endif @@ -859,6 +1038,54 @@ subroutine from_netcdf_to_mit_tracer(ncid, name) end subroutine from_netcdf_to_mit_tracer +!------------------------------------------------------------------ +subroutine from_netcdf_to_mit_tracer_pickup(ncid, name, lev) + +integer, intent(in) :: ncid ! which file +character(len=*), intent(in) :: name ! which variable + +integer :: iunit, lev +real(r4) :: var(Nx,Ny,Nz) +real(r8) :: var8(Nx,Ny,Nz) +integer :: varid +real(r4) :: local_fval +real(r4) :: low_conc, large_conc = 5.0 ! From Siva's old code + +low_conc = 1.0e-12 + +call check( NF90_INQ_VARID(ncid,name,varid) ) +call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) + +! initialize var to netcdf fill value +var(:,:,:) = local_fval + +if (compress) then + call read_compressed(ncid, varid, var, MITgcm_3D_FIELD) +else + call check(nf90_get_var(ncid,varid,var)) +endif + +if (log_transform) then + where (var == local_fval) + var = binary_fill + elsewhere + var = exp(var) + endwhere +else + where (var == local_fval) var = binary_fill + where (var > large_conc) var = low_conc +endif + +var8 = var + +iunit = get_unit() +open(iunit, file='PICKUP_PTRACERS.OUTPUT', form="UNFORMATTED", status='UNKNOWN', & + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') +write(iunit,rec=lev) var8 +close(iunit) + +end subroutine from_netcdf_to_mit_tracer_pickup + !------------------------------------------------------------------ subroutine from_netcdf_to_mit_tracer_chl(ncid, name) @@ -900,15 +1127,20 @@ end subroutine from_netcdf_to_mit_tracer_chl !------------------------------------------------------------------ ! Assumes all 3D variables are masked in the ! same location -function get_compressed_size_3d() result(n3) +function get_compressed_size_3d(field) result(n3) -integer :: n3 -integer :: iunit -real(r4) :: var3d(NX,NY,NZ) -integer :: i,j,k +integer :: n3, field +integer :: iunit +real(r4) :: var3d(NX,NY,NZ) +integer :: i, j, k +character(len=MAX_LEN_FNAM) :: source + +if (field == MITgcm_3D_FIELD) source = 'PSAL.data' +if (field == MITgcm_3D_FIELD_U) source = 'UVEL.data' +if (field == MITgcm_3D_FIELD_V) source = 'VVEL.data' iunit = get_unit() -open(iunit, file='PSAL.data', form='UNFORMATTED', status='OLD', & +open(iunit, file=trim(source), form='UNFORMATTED', status='OLD', & access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') read(iunit,rec=1) var3d close(iunit) @@ -935,13 +1167,13 @@ function get_compressed_size_2d() result(n2) integer :: n2 integer :: iunit -real(r4) :: var2d(NX,NY) +real(r4) :: var3d(NX,NY,NZ) integer :: i,j iunit = get_unit() -open(iunit, file='ETA.data', form='UNFORMATTED', status='OLD', & - access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') -read(iunit,rec=1) var2d +open(iunit, file='PTMP.data', form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') +read(iunit,rec=1) var3d close(iunit) n2 = 0 @@ -949,7 +1181,7 @@ function get_compressed_size_2d() result(n2) ! Get compressed size do i=1,NX do j=1,NY - if (var2d(i,j) /= binary_fill) then !HK also NaN? + if (var3d(i,j,1) /= binary_fill) then !HK also NaN? n2 = n2 + 1 endif enddo @@ -993,6 +1225,52 @@ subroutine fill_compressed_coords() enddo enddo +! UVEL: +iunit = get_unit() +open(iunit, file='UVEL.data', form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') +read(iunit,rec=1) var3d +close(iunit) + +n = 1 + +do k=1,NZ ! k first so 2d is first + do i=1,NX + do j=1,NY + if (var3d(i,j,k) /= binary_fill) then !HK also NaN? + Xcomp_indU(n) = i + Ycomp_indU(n) = j + Zcomp_indU(n) = k + + n = n + 1 + endif + enddo + enddo +enddo + +! VVEL: +iunit = get_unit() +open(iunit, file='VVEL.data', form='UNFORMATTED', status='OLD', & + access='DIRECT', recl=recl3d, convert='BIG_ENDIAN') +read(iunit,rec=1) var3d +close(iunit) + +n = 1 + +do k=1,NZ ! k first so 2d is first + do i=1,NX + do j=1,NY + if (var3d(i,j,k) /= binary_fill) then !HK also NaN? + Xcomp_indV(n) = i + Ycomp_indV(n) = j + Zcomp_indV(n) = k + + n = n + 1 + endif + enddo + enddo +enddo + end subroutine fill_compressed_coords !------------------------------------------------------------------ @@ -1020,35 +1298,57 @@ subroutine write_compressed_2d(ncid, varid, var_data) end subroutine write_compressed_2d !------------------------------------------------------------------ -subroutine write_compressed_3d(ncid, varid, var_data) +subroutine write_compressed_3d(ncid, varid, var_data, field) -integer, intent(in) :: ncid, varid +integer, intent(in) :: ncid, varid, field real(r4), intent(in) :: var_data(Nx,Ny,Nz) -real(r4) :: comp_var(ncomp3) +real(r4), allocatable :: comp_var(:) integer :: n integer :: i,j,k ! loop variables -n = 1 -do k = 1 , NZ !k first so 2d is first - do i = 1, NX - do j = 1, NY - if (var_data(i,j,k) /= FVAL) then - comp_var(n) = var_data(i,j,k) - n = n + 1 - endif - enddo - enddo -enddo +if (field == MITgcm_3D_FIELD_U) then + allocate(comp_var(ncomp3U)) + do i = 1,ncomp3U + comp_var(i) = var_data(Xcomp_indU(i), Ycomp_indU(i), Zcomp_indU(i)) + enddo + +elseif (field == MITgcm_3D_FIELD_V) then + allocate(comp_var(ncomp3V)) + do i = 1,ncomp3V + comp_var(i) = var_data(Xcomp_indV(i), Ycomp_indV(i), Zcomp_indV(i)) + enddo + +else + allocate(comp_var(ncomp3)) + do i = 1,ncomp3 + comp_var(i) = var_data(Xcomp_ind(i), Ycomp_ind(i), Zcomp_ind(i)) + enddo +endif + +!n = 1 +!do k = 1, NZ !k first so 2d is first +! do i = 1, NX +! do j = 1, NY +! if (var_data(i,j,k) /= FVAL) then +! print *, 'n: ', n, ', var_data(i,j,k): ', var_data(i,j,k) +! comp_var(n) = var_data(i,j,k) +! n = n + 1 +! endif +! enddo +! enddo +!enddo call check(nf90_put_var(ncid,varid,comp_var)) +deallocate(comp_var) + end subroutine write_compressed_3d !------------------------------------------------------------------ subroutine read_compressed_2d(ncid, varid, var) -integer, intent(in) :: ncid, varid +integer, intent(in) :: ncid, varid real(r4), intent(inout) :: var(NX,NY) real(r4) :: comp_var(ncomp2) @@ -1060,11 +1360,11 @@ subroutine read_compressed_2d(ncid, varid, var) call check(nf90_get_var(ncid,varid,comp_var)) -do n = 1, ncomp3 +do n = 1, ncomp3 i = Xcomp_ind(n) j = Ycomp_ind(n) k = Zcomp_ind(n) - if (k == 1 ) then + if (k == 1) then var(i,j) = comp_var(c) c = c + 1 endif @@ -1073,23 +1373,47 @@ subroutine read_compressed_2d(ncid, varid, var) end subroutine read_compressed_2d !------------------------------------------------------------------ -subroutine read_compressed_3d(ncid, varid, var) +subroutine read_compressed_3d(ncid, varid, var, field) -integer, intent(in) :: ncid, varid +integer, intent(in) :: ncid, varid, field real(r4), intent(inout) :: var(NX,NY,NZ) -real(r4) :: comp_var(ncomp3) +real(r4), allocatable :: comp_var(:) integer :: n ! loop variable integer :: i,j,k ! x,y,k -call check(nf90_get_var(ncid,varid,comp_var)) +if (field == MITgcm_3D_FIELD_U) then + allocate(comp_var(ncomp3U)) + call check(nf90_get_var(ncid,varid,comp_var)) + do n = 1, ncomp3U + i = Xcomp_indU(n) + j = Ycomp_indU(n) + k = Zcomp_indU(n) + var(i,j,k) = comp_var(n) + enddo + +elseif (field == MITgcm_3D_FIELD_V) then + allocate(comp_var(ncomp3V)) + call check(nf90_get_var(ncid,varid,comp_var)) + do n = 1, ncomp3V + i = Xcomp_indV(n) + j = Ycomp_indV(n) + k = Zcomp_indV(n) + var(i,j,k) = comp_var(n) + enddo -do n = 1, ncomp3 - i = Xcomp_ind(n) - j = Ycomp_ind(n) - k = Zcomp_ind(n) - var(i,j,k) = comp_var(n) -enddo +else + allocate(comp_var(ncomp3)) + call check(nf90_get_var(ncid,varid,comp_var)) + do n = 1, ncomp3 + i = Xcomp_ind(n) + j = Ycomp_ind(n) + k = Zcomp_ind(n) + var(i,j,k) = comp_var(n) + enddo +endif + +deallocate(comp_var) end subroutine read_compressed_3d From 40b1dc3f8e09a4db0ad5fa17d721bf0b0da3568c Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 26 Jan 2024 12:57:04 -0700 Subject: [PATCH 061/124] Removed outdated TODOs, commented out code and comments containing KDR and NEWIC Trimmed and updated comments about TODO, f107, TEC, GITM, TIEGCM. --- models/aether_lon-lat/model_mod.f90 | 257 ++++++++-------------------- models/aether_lon-lat/model_mod.nml | 3 +- 2 files changed, 76 insertions(+), 184 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 37ce65bbfe..2d349dbbe1 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -107,7 +107,7 @@ module model_mod integer :: time_step_seconds = 3600 integer :: debug = 0 -! KDR Should this be defined here, or does it come from netcdf_utilities_mod.f90? +! TODO: Should this be defined here, or does it come from netcdf_utilities_mod.f90? ! It's a public parameter from that module, which gets it from the netcdf module ! https://docs.unidata.ucar.edu/netcdf-fortran/current/f90-variables.html#f90-variables-introduction ! integer, parameter :: NF90_MAX_NAME = 256 @@ -124,8 +124,7 @@ module model_mod !----------------------------------------------------------------------- character(len=256) :: aether_restart_dirname = 'none' -! TODO: the calling script will need to move this to a name with $member in it, -! or use filter_nml:input_state_file_list +! An ensemble of file names is created using this root and $member in it, character (len = vtablenamelength) :: filter_io_root = 'filter_input' namelist /aether_to_dart_nml/ aether_restart_dirname, filter_io_root, variables, debug @@ -136,18 +135,29 @@ module model_mod namelist /dart_to_aether_nml/ aether_restart_dirname, filter_io_root, variables, debug !------------------------------------------------------------------------------- -! to be assigned in the assign_dimensions subroutine -real(r8), allocatable :: levs(:), lats(:), lons(:) +! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table +! VT_ORIGININDX is used differently from the usual domains context. +! It does not provide full path+filenames. Here it is used by aether_to_dart and +! dart_to_aether to identify whether a variable comes from a neutrals or ions block file. +! It is not used by filter's definition of a domain. +integer, parameter :: VT_VARNAMEINDX = 1 ! ... variable name +integer, parameter :: VT_KINDINDX = 2 ! ... DART kind +integer, parameter :: VT_MINVALINDX = 3 ! ... minimum value if any +integer, parameter :: VT_MAXVALINDX = 4 ! ... maximum value if any +integer, parameter :: VT_ORIGININDX = 5 ! file of origin +integer, parameter :: VT_STATEINDX = 6 ! ... update (state) or not + +! to be assigned in assign_dimensions (for filter) +! or get_grid_from_blocks (aether_to_dart, dart_to_aether). +real(r8), allocatable :: levs(:), lats(:), lons(:) ! Can't just change this to r4. ! I'll need to read the dims from filter_input_0001.nc into r4 temp array, ! then convert to these r8 vars. -integer :: nlev, nlat, nlon -real(r8) :: lon_start, lon_delta, lat_start, lat_delta, lat_end +integer :: nlev, nlat, nlon +real(r8) :: lon_start, lon_delta, lat_start, lat_delta, lat_end -! write_model_time creates a time dimension with the UNLIMITED characteristic. -! The variable must have the time dimension, even if it's always only 1 (in restart files). ! TODO: using length * causes(?) a problem when calling nc_define_var_real_Nd ! with the list of dim_names in this order. nc_define also uses size * ! and apparently looks at the first one, sees that it's size 3, and assumes that for all. @@ -168,6 +178,7 @@ module model_mod integer :: nblocks_lon=MISSING_I, nblocks_lat=MISSING_I, nblocks_lev=MISSING_I ! TODO: should nghost be read from the namelist? +! Aaron; not in the foreseeable future. integer :: nx_per_block, ny_per_block, nz_per_block integer, parameter :: nghost = 2 ! number of ghost cells on all edges @@ -192,16 +203,6 @@ module model_mod type(quad_interp_handle) :: quad_interp -! Codes for interpreting the columns of the variables table -! KDR; Move this closer to definition of variables( , ) -! so that it's clearer how many columns there need to be. -integer, parameter :: VT_VARNAMEINDX = 1 ! ... variable name -integer, parameter :: VT_KINDINDX = 2 ! ... DART kind -integer, parameter :: VT_MINVALINDX = 3 ! ... minimum value if any -integer, parameter :: VT_MAXVALINDX = 4 ! ... maximum value if any -integer, parameter :: VT_ORIGININDX = 5 ! file of origin -integer, parameter :: VT_STATEINDX = 6 ! ... update (state) or not - integer, parameter :: GENERAL_ERROR_CODE = 99 integer, parameter :: INVALID_VERT_COORD_ERROR_CODE = 15 integer, parameter :: INVALID_LATLON_VAL_ERROR_CODE = 16 @@ -419,8 +420,7 @@ subroutine get_state_meta_data(index_in, location, qty) if ( .not. module_initialized ) call static_init_model -! KDR restart data is ordered (lev,lat,lon) -! call get_model_variable_indices(index_in, lon_index, lat_index, lev_index, & +! Restart data is ordered (lev,lat,lon) (translated from C to fortran). call get_model_variable_indices(index_in, lev_index, lat_index, lon_index, & var_id=my_var_id, kind_index=my_qty) @@ -512,7 +512,7 @@ subroutine nc_write_model_atts(ncid, domain_id) call nc_add_global_attribute(ncid, "model_source", source, routine) call nc_add_global_attribute(ncid, "model", "aether", routine) -! TODO KDR Shouldn't the calendar type be defined here? +! TODO Shouldn't the calendar type be defined here? ! It's defined in the time variable = good enough for write_model_time. ! call nc_end_define_mode(ncid) @@ -539,9 +539,6 @@ subroutine def_fill_dimvars(ncid) call nc_define_dimension(ncid, trim(LEV_DIM_NAME), nlev, routine) call nc_define_dimension(ncid, trim(LAT_DIM_NAME), nlat, routine) call nc_define_dimension(ncid, trim(LON_DIM_NAME), nlon, routine) -! TODO: UNLIMITED (time ) should be the last dimension. Document it? -! NO. The file should have no time dimension, just a scalar time variable -! call nc_define_unlimited_dimension(ncid, trim(TIME_DIM_NAME), routine) ! define grid variables ! z @@ -573,7 +570,6 @@ subroutine def_fill_dimvars(ncid) call nc_put_variable(ncid, trim(LAT_VAR_NAME), lats, routine) call nc_put_variable(ncid, trim(LON_VAR_NAME), lons, routine) ! time will be written elsewhere. -print*,routine,': passed putting the dimensions' ! Flush the buffer and leave netCDF file open call nc_synchronize_file(ncid) @@ -643,14 +639,11 @@ subroutine verify_variables(variables, file, nvar, & nvar = 0 MyLoop : do i = 1, size(variables,2) -! KDR Why define these intermediate strings? Is the code clearer or faster? +! TODO Why define these intermediate strings? Is the code clearer or faster? varname = variables(VT_VARNAMEINDX,i) dartstr = variables(VT_KINDINDX,i) minvalstring = variables(VT_MINVALINDX,i) maxvalstring = variables(VT_MAXVALINDX,i) -! KDR The innards of DART expect the VT_ORIGININDX to be an actual NetCDF file name -! But this 'file' variable is not used here (yet?). -! file = variables(VT_ORIGININDX,i) state_or_aux = variables(VT_STATEINDX,i) if ( varname == ' ' .and. dartstr == ' ' ) exit MyLoop ! Found end of list. @@ -806,17 +799,14 @@ subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & do icorner=1, 4 -! KDR Most rapidly varying dim must be first -! state_indx = get_dart_vector_index(four_lons(icorner), four_lats(icorner), & -! lev1, dom_id, varid) + ! Most rapidly varying dim must be first state_indx = get_dart_vector_index(lev1 ,four_lats(icorner), & four_lons(icorner), dom_id, varid) if (state_indx < 0) then write(error_string_1,*) 'Could not find dart state index from ' -! KDR original printed lev2, even though it has not been used yet. - write(error_string_2,*) 'lon, lat, and lev1(,2) index :', four_lons(icorner), four_lats(icorner), & - lev1,lev2 + write(error_string_2,*) 'lon, lat, and lev1 index :', four_lons(icorner), four_lats(icorner), & + lev1 call error_handler(E_ERR,routine,error_string_1,source,revision,revdate,text2=error_string_2) return endif @@ -828,7 +818,7 @@ subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & if (state_indx < 0) then write(error_string_1,*) 'Could not find dart state index from ' - write(error_string_2,*) 'lon, lat, and lev index :', four_lons(icorner), four_lats(icorner), lev2 + write(error_string_2,*) 'lon, lat, and lev2 index :', four_lons(icorner), four_lats(icorner), lev2 call error_handler(E_ERR,routine,error_string_1,source,revision,revdate,text2=error_string_2) return endif @@ -909,7 +899,6 @@ end subroutine ok_to_interpolate subroutine restart_files_to_netcdf(member) - ! TODO: Does restart_files_to_netcdf need restart_dir? integer, intent(in) :: member integer :: ncid @@ -935,19 +924,15 @@ subroutine restart_files_to_netcdf(member) call error_handler(E_MSG, routine, error_string_1, text2=error_string_2) call error_handler(E_MSG, '', '') - ! Aether_to_dart and dart_to_aether want only a few lines from - ! nc_write_model_atts -> static_init_model, - ! not domain definition, etc. Put those lines in def_fill_dimvars. - ! TODO: I may need to copy some bits from static_init_model into static_init_blocks - ! TODO: we haven't settled on the mechanism for identifying the state vector field names and source. + ! (defined type, arrays, named indices,...) ! TODO: def_fill_dimvars functionality was in nc_write_model_atts but shouldn't have been. ! I separated nc_write_model_atts into to parts and this is one of them. - ! Is this a good place for the call? It's in the "define" section for the filter_input file. + ! Is this the best place for the call? It's in the "define" section for the filter_input file. + ! It works. call def_fill_dimvars(ncid) ! Write_model_time will make a time variable, if needed, which it is not. - ! write_model_time does not open the file, call write_model_time(ncid, state_time) ! Define (non-time) variables @@ -969,7 +954,7 @@ end subroutine restart_files_to_netcdf !================================================================= ! Writes the current time and state variables from a dart state -! vector (1d array) into a gitm netcdf restart file. +! vector (1d array) into Aether netcdf restart file sets. subroutine netcdf_to_restart_files(member) @@ -982,7 +967,7 @@ subroutine netcdf_to_restart_files(member) ! when this routine returns all the data has been written. if (module_initialized ) then - write(error_string_1,*)'The gitm mod was already initialized but ',trim(routine),& + write(error_string_1,*)'The aether mod was already initialized but ',trim(routine),& ' uses a separate initialization procedure' call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) end if @@ -1017,9 +1002,9 @@ end subroutine netcdf_to_restart_files function block_file_name(filetype, memnum, blocknum) character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} - ! TODO: ? Will this need to open the grid_{below,corners,down,left} filetypes? - ! This code can handle it; a longer filetype passed in, and no member. - ! ? output files? + ! ? Will this need to open the grid_{below,corners,down,left} filetypes? + ! This code can handle it; a longer filetype passed in, and no member. + ! ? Aether output files? integer, intent(in) :: blocknum integer, intent(in) :: memnum character(len=128) :: block_file_name @@ -1049,7 +1034,6 @@ subroutine static_init_blocks(nml) character(len=vtablenamelength) :: varname integer :: iunit, io, ivar - !logical :: has_gitm_namelist if (module_initialized) return ! only need to do this once @@ -1057,12 +1041,8 @@ subroutine static_init_blocks(nml) module_initialized = .true. !---------------------------------------------------------------------- - ! Read the aether_to_dart namelist - !---------------------------------------------------------------------- - ! NEWIC; a2d will now read 'variables' from its own namelist. - ! I think/hope that a2d doesn't need any other variables from model_nml. + ! Read the namelist - ! TODO: filter_io_dir from here instead of redundant entry in model_mod_nml? call find_namelist_in_file("input.nml", trim(nml), iunit) if (trim(nml) == 'aether_to_dart_nml') then read(iunit, nml = aether_to_dart_nml, iostat = io) @@ -1078,17 +1058,17 @@ subroutine static_init_blocks(nml) call check_namelist_read(iunit, io, trim(nml)) ! closes, too. - ! error-check, convert namelist input to variables, and build the state structure - ! 'variables' comes from model_nml in input.nml + ! error-check, convert namelist input to arrays. + ! 'variables' comes from the namelist in input.nml call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) !--------------------------------------------------------------- ! TODO: Set the time step ! Ensures model_advance_time is multiple of 'dynamics_timestep' - !TODO: Aether uses Julian time internally - ! andor a Julian calendar (days from the start of the calendar), depending on the context) - call set_calendar_type( calendar ) ! comes from model_mod_nml + ! Aether uses Julian time internally, andor a Julian calendar + ! (days from the start of the calendar), depending on the context) + call set_calendar_type( calendar ) !--------------------------------------------------------------- ! 1) get grid dimensions @@ -1136,9 +1116,9 @@ subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, & integer, intent(out) :: nblocks_lon, nblocks_lat, nblocks_lev real(r8), intent(out) :: lat_start, lat_end, lon_start - ! TODO: get the grid info from a namelists (98 variables), instead of GITM's UAM.in. + ! TODO: get the grid info from a namelist (98 variables), instead of Aether's UAM.in. ! Then remove functions read_in_*. - ! The rest of the UAM.in contents are for running GITM. + ! The rest of the UAM.in contents are for running Aether. ! Can wait until aether_to_dart push is done. character(len=*), parameter :: filename = 'UAM.in' @@ -1260,12 +1240,14 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) ! TODO; do these need to be deallocated somewhere? + ! Probably not; this is only done once, and these arrays are needed + ! through most of the a2d and d2a programs. allocate( lons( nlon )) allocate( lats( nlat )) allocate( levs( nlev )) if (debug > 4) then - write(error_string_1,*) 'Successfully read GITM grid file:',trim(filename) + write(error_string_1,*) 'Successfully read Aether grid file:',trim(filename) call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) write(error_string_1,*) ' nx_per_block:',nx_per_block call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) @@ -1281,9 +1263,7 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, allocate(temp( 1:nz_per_block, & 1-nghost:ny_per_block+nghost, & 1-nghost:nx_per_block+nghost)) -! TODO; use MISSING_R4 instead? - temp = -888888. - + temp = MISSING_R4 starts(1) = 1-nghost starts(2) = 1-nghost @@ -1324,8 +1304,8 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, ! go up west-most block row picking up all latitudes do nb = 1, nblocks_lat - ! TODO; Aether block name counters start with 0, but the lat values can come from - ! any lon=const column. + ! Aether's block name counter start with 0, but the lat values can come from + ! any lon=const column of blocks. nboff = ((nb - 1) * nblocks_lon) filename = block_file_name('grid', -1, nboff) ncid = open_block_file(filename, 'read') @@ -1403,9 +1383,8 @@ function read_aether_time(filename) ! TODO: review calculation of ndays in read_aether_time ndays = tsimulation/86400 nsecs = tsimulation - ndays*86400 -! Need to subtract 1 because the ref day is not finished. -! NO, that was accounted for in the integer calculation of ndays. -! ndays = aether_ref_ndays -1 + ndays +! The ref day is not finished, but don't need to subtract 1 because +! that was accounted for in the integer calculation of ndays. ndays = aether_ref_ndays + ndays read_aether_time = set_time(nsecs,ndays) @@ -1449,7 +1428,8 @@ function aether_name_to_dart(varname) var_root = aether(char_num+1:aether_len) ! purge_chars removes unwanted [()\] parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) - print*,'var_root, parts(1) = ',var_root, parts(1) + ! TODO: keep aether_name_to_dart diagnostic? + ! print*,'var_root, parts(1) = ',var_root, parts(1) end_str = char_num ! Tranform remaining pieces of varname into DART versions. @@ -1716,7 +1696,6 @@ subroutine write_filter_io(data3d, varname, block, ncid) ! print*,routine,'; starts = ',starts ! print*,routine,'; counts = ',nz_per_block,ny_per_block,nx_per_block,1 -! data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & call nc_put_variable(ncid, varname, & data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & context=routine, nc_start=starts, & @@ -1777,12 +1756,15 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) 1-nghost:ny_per_block+nghost, & 1-nghost:nx_per_block+nghost)) + ! TODO: Waiting for e- guidance from Aaron. ! save density_ion_e to compute TEC allocate(density_ion_e(1:nz_per_block, & 1-nghost:ny_per_block+nghost, & 1-nghost:nx_per_block+nghost)) - ! Aether gives a unique name to each (of 6) velocity components + ! TODO: Aether gives a unique name to each (of 6) velocity components. + ! Do we want to use a temp4d array to handle them? + ! They are independent variables in the block files (and state). ! ! temp array large enough to hold velocity vect, etc ! maxsize = max(3, nSpecies) ! allocate(temp4d(1-nghost:nx_per_block+nghost, & @@ -1794,40 +1776,6 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! But they are probably read by the loops below. ! Don't need to fetch index because Aether has NetCDF restarts, ! so just loop over the field names to read. - ! Read the index from the first species - ! call get_index_from_gitm_varname('NDensityS', inum, ivals) - - ! if (inum > 0) then - ! ! if i equals ival, use the data from the state vect - ! ! otherwise read/write what's in the input file - ! j = 1 - ! do i = 1, nSpeciesTotal - ! if (debug > 80) then - ! write(error_string_1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading species ',i,' of ',nSpeciesTotal, & - ! ' for block (',ib,',',jb,')' - ! call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - ! end if - ! read(iunit) temp3d - ! if (j <= inum) then - ! if (i == gitmvar(ivals(j))%gitm_index) then - ! call write_filter_io(temp3d, ivals(j), block, ncid) - ! j = j + 1 - ! endif - ! endif - ! enddo - ! else - ! if (debug > 80) then - ! write(error_string_1,'(A)') 'Not writing the NDensityS variables to file' - ! call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - ! end if - ! ! nothing at all from this variable in the state vector. - ! ! copy all data over from the input file to output file - ! do i = 1, nSpeciesTotal - ! read(iunit) temp3d - ! enddo - ! endif - ! - ! call get_index_from_gitm_varname('IDensityS', inum, ivals) ! ! ! assume we could not find the electron density for VTEC calculations ! no_idensity = .true. @@ -1838,38 +1786,10 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! j = 1 ! ! TODO: electron density is not in the restart files, but it's needed for TEC ! In Aether they will be from an ions file, but now only from an output file (2023-10-30). - ! do i = 1, nIons - ! if (debug > 80) then - ! write(error_string_1,'(A,I0,A,I0,A,I0,A,I0,A)') 'Now reading ion ',i,' of ',nIons, & - ! ' for block (',ib,',',jb,')' - ! call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - ! end if - ! read(iunit) temp3d - ! if (j <= inum) then - ! if (i == gitmvar(ivals(j))%gitm_index) then - ! ! ie_, the gitm index for electron density, comes from ModEarth - ! if (gitmvar(ivals(j))%gitm_index == ie_) then + ! Can that be handled like the neutrals and ions files, using variables(VT_ORIGININDX,:) + ! to build an output file name? Are outputs in block form? ! ! save the electron density for TEC computation ! density_ion_e(:,:,:) = temp3d(:,:,:) - ! no_idensity = .false. - ! end if - ! ! read from input but write from state vector - ! call write_filter_io(temp3d, ivals(j), block, ncid) - ! j = j + 1 - ! endif - ! endif - ! enddo - ! else - ! ! nothing at all from this variable in the state vector. - ! ! read past this variable - ! if (debug > 80) then - ! write(error_string_1,'(A)') 'Not writing the IDensityS variables to file' - ! call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - ! end if - ! do i = 1, nIons - ! read(iunit) temp3d - ! enddo - ! endif ! Handle the 2 restart file types (ions and neutrals). ! Each field has a file type associated with it: variables(VT_ORIGININDX,f_index) @@ -1879,10 +1799,10 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) filename = block_file_name(file_root, member, nb) ncid_input = open_block_file(filename, 'read') + ! TODO: prints > ERR_MSG? if (debug >= 100 .and. do_output()) print*,'block_to_filter_io: nvar_neutral = ',nvar_neutral do ivar = 1, nvar_neutral - ! TODO: the nf90 functions cannot read the variable names with the '\'s in them. - ! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) + ! The nf90 functions cannot read the variable names with the '\'s in them. varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) if (debug >= 100 .and. do_output()) print*,routine,'varname = ',varname ! Translate the Aether field name into a DART field name. @@ -1909,7 +1829,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. call nc_get_variable(ncid_input, varname, temp3d, context=routine) if (debug >= 100 .and. do_output()) then - ! TODO convert to error_handler? + ! TODO convert to error_handler? Or diagnostics are no longer useful? print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),varname print*,'block_to_filter_io: define = ',define endif @@ -1927,14 +1847,9 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) filename = block_file_name(file_root, member, nb) ncid_input = open_block_file(filename, 'read') - print*,'block_to_filter_io: nvar_ion = ',nvar_ion do ivar = nvar_neutral +1,nvar_neutral + nvar_ion - ! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) -! print*,'Purging \ from aether name' + ! Purging \ from aether name. varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - ! NEWIC; - ! Translate the Aether field name into a DART field name. -! print*,'Converting aether name ',trim(varname) dart_varname = aether_name_to_dart(varname) if (define) then @@ -1967,43 +1882,32 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! TODO: Does Aether need TEC to be calculated? Yes ! ! add the VTEC as an extended-state variable - ! ! NOTE: This variable will *not* be written out to the GITM blocks to netCDF program - ! call get_index_from_gitm_varname('TEC', inum, ivals) + ! ! NOTE: This variable will *not* be written out to the Aether restart files ! - ! if (inum > 0 .and. no_idensity) then + ! if (no_idensity) then ! write(error_string_1,*) 'Cannot compute the VTEC without the electron density' ! call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) ! end if ! - ! if (inum > 0) then - ! if (.not. define) then ! temp2d = 0._r8 - ! ! comptue the TEC integral + ! ! compute the TEC integral ! do i =1,nz_per_block-1 ! approximate the integral over the altitude as a sum of trapezoids ! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 - ! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 + ! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * & + ! ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 ! end do ! ! convert temp2d to TEC units ! temp2d = temp2d/1e16_r8 - ! end if ! call write_block_to_filter2d(temp2d, ivals(1), block, ncid, define) - ! end if ! TODO: Does Aether need f10_7 to be calculated or processed? Yes - ! read(iunit) temp0d ! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') ! call get_index_from_gitm_varname('f107', inum, ivals) ! if (inum > 0) then ! call write_block_to_filter0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine ! endif ! - ! read(iunit) temp3d - ! call get_index_from_gitm_varname('Rho', inum, ivals) - ! if (inum > 0) then - ! call write_block_to_filter(temp3d, ivals(1), block, ncid, define) - ! endif - - !print *, 'calling dealloc' + deallocate(temp1d, temp2d, temp3d) deallocate(alt1d, density_ion_e) @@ -2031,7 +1935,8 @@ subroutine filter_to_restarts(ncid, member) ! get the dirname, construct the filenames inside open_block_file ! >>> TODO: Not all fields have halos suitable for calculating gradients. - ! These do (2023-11-8): neutral temperature, O, O2, N2, and the horizontal winds. + ! These do (2023-11-8): neutrals; temperature, O, O2, N2, and the horizontal winds. + ! ions; none. ! The current model_mod will fill all neutral halos anyway, ! since that's simpler and won't break the model. ! TODO: add an attribute to the variables (?) to denote whether a field @@ -2042,13 +1947,11 @@ subroutine filter_to_restarts(ncid, member) write(error_string_1,'("varname = ",A)') trim(varname) call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) endif - ! NEWIC; - ! Translate the Aether field name into a DART field name. dart_varname = aether_name_to_dart(varname) file_root = trim(variables(VT_ORIGININDX,ivar)) if (file_root == 'neutrals') then - ! Assuming that this parameter is available through the `use netcdf` command. + ! This parameter is available through the `use netcdf` command. fulldom3d = NF90_FILL_REAL call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & @@ -2068,8 +1971,6 @@ subroutine filter_to_restarts(ncid, member) do ivar = nvar_neutral+1, nvar_neutral + nvar_ion varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - ! NEWIC; - ! Translate the Aether field name into a DART field name. dart_varname = aether_name_to_dart(varname) file_root = trim(variables(VT_ORIGININDX,ivar)) @@ -2085,8 +1986,6 @@ subroutine filter_to_restarts(ncid, member) nc_count=(/nlev,nlat,nlon,1/),context=routine) !? ncount not needed? Reading the whole field. - ! Copy updated field values to full domain halo. - ! Block domains+halos will be easily read from this. ! 2023-11: ions do not have real or used data in their halos. ! Make this clear by leaving the halos filled with MISSING_R4 ! TODO: Will this be translated into NetCDF missing_value? @@ -2163,7 +2062,7 @@ subroutine add_halo_fulldom3d(fulldom3d) endif ! TODO: Keep halo corners check for future use? - ! Then add debug conditional . Also, more robust rescaling. + ! Add more robust rescaling. ! Debug; print the 4x4 arrays (corners & middle) ! to see whether values are copied correctly ! Level 44 values range from 800-eps to 805. I don't want to see the 80. @@ -2261,7 +2160,6 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) ncid_output = open_block_file(block_file, 'readwrite') ! TODO: error checking; does the block file have the field in it? - ! convert prints to error_handler if ( debug > 0 .and. do_output()) then write(error_string_1,'(A,3(2X,i5))') "block, ib, jb = ", nb, ib, jb call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) @@ -2280,17 +2178,10 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) enddo ! - ! !alex begin: added f107 and Rho to the restart files: - ! read(iunit) temp0d - ! data0d = temp0d - ! call get_index_from_gitm_varname('f107', inum, ivals) - ! if (inum > 0) then + ! TODO: ? Add f107 and Rho to the restart files ! call read_filter_io_block0d(ncid, ivals(1), data0d) ! if (data0d < 0.0_r8) data0d = 60.0_r8 !alex ! write(ounit) data0d - ! else - ! write(ounit) temp0d - ! endif end subroutine filter_io_to_blocks diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index 24c1ccc070..08d8aba8c9 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -1,4 +1,5 @@ -Ben's: namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables +TODO? Ben's: namelist + /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables Future?: x estimate_f10_7 = .false. From 926b0b84a2891729cf1ef4bcfc2528f19dadea40 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 26 Jan 2024 19:56:37 -0700 Subject: [PATCH 062/124] Apply style guide's non-functional items Indenting, spaces, alignment, routine separation. Add descriptions of routines to their headers. Eliminate doxygen code. --- models/aether_lon-lat/model_mod.f90 | 3154 ++++++++++++++------------- 1 file changed, 1595 insertions(+), 1559 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 2d349dbbe1..d502c4e493 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -5,48 +5,55 @@ module model_mod -!------------------------------------------------------------------------------- +!----------------------------------------------------------------------- ! ! Interface for Aether ! -!------------------------------------------------------------------------------- - -use types_mod, only : r4, r8, i8, MISSING_R4, MISSING_R8, vtablenamelength, MISSING_I, RAD2DEG - -use time_manager_mod, only : time_type, set_calendar_type, set_time, get_time, set_date, & - print_date, print_time - -use location_mod, only : location_type, get_close_type, & - loc_get_close_obs => get_close_obs, & - loc_get_close_state => get_close_state, & - is_vertical, set_location, set_location_missing, & - VERTISHEIGHT, query_location, get_location - -use utilities_mod, only : open_file, close_file, file_exist, logfileunit, register_module, & - error_handler, E_ERR, E_MSG, E_WARN, & - nmlfileunit, do_output, do_nml_file, do_nml_term, & - find_namelist_in_file, check_namelist_read, to_upper, & - find_enclosing_indices - -use obs_kind_mod, only : QTY_GEOMETRIC_HEIGHT - -use netcdf_utilities_mod, only : nc_add_global_attribute, nc_synchronize_file, & - nc_add_global_creation_time, & - nc_begin_define_mode, nc_end_define_mode, & - nc_open_file_readonly, nc_get_dimension_size, nc_create_file, & - nc_close_file, nc_get_variable, nc_define_dimension, & - nc_define_real_variable, nc_define_real_scalar, nc_open_file_readwrite, & - nc_add_attribute_to_variable, nc_put_variable, & - nc_get_attribute_from_variable, NF90_FILL_REAL +!----------------------------------------------------------------------- -use quad_utils_mod, only : quad_interp_handle, init_quad_interp, set_quad_coords, & - quad_lon_lat_locate, quad_lon_lat_evaluate, & - GRID_QUAD_FULLY_REGULAR, QUAD_LOCATED_CELL_CENTERS +use types_mod, only : & + r4, r8, i8, MISSING_R4, MISSING_R8, vtablenamelength, MISSING_I, RAD2DEG + +use time_manager_mod, only : & + time_type, set_calendar_type, set_time, get_time, set_date, & + print_date, print_time + +use location_mod, only : & + location_type, get_close_type, & + loc_get_close_obs => get_close_obs, & + loc_get_close_state => get_close_state, & + is_vertical, set_location, set_location_missing, & + VERTISHEIGHT, query_location, get_location + +use utilities_mod, only : & + open_file, close_file, file_exist, logfileunit, register_module, & + error_handler, E_ERR, E_MSG, E_WARN, & + nmlfileunit, do_output, do_nml_file, do_nml_term, & + find_namelist_in_file, check_namelist_read, to_upper, & + find_enclosing_indices + +use obs_kind_mod, only : QTY_GEOMETRIC_HEIGHT + +use netcdf_utilities_mod, only : & + nc_add_global_attribute, nc_synchronize_file, & + nc_add_global_creation_time, & + nc_begin_define_mode, nc_end_define_mode, & + nc_open_file_readonly, nc_get_dimension_size, nc_create_file, & + nc_close_file, nc_get_variable, nc_define_dimension, & + nc_define_real_variable, nc_define_real_scalar, nc_open_file_readwrite, & + nc_add_attribute_to_variable, nc_put_variable, & + nc_get_attribute_from_variable, NF90_FILL_REAL + +use quad_utils_mod, only : & + quad_interp_handle, init_quad_interp, set_quad_coords, & + quad_lon_lat_locate, quad_lon_lat_evaluate, & + GRID_QUAD_FULLY_REGULAR, QUAD_LOCATED_CELL_CENTERS use obs_kind_mod, only : get_index_for_quantity -use state_structure_mod, only : add_domain, get_dart_vector_index, get_domain_size, & - get_model_variable_indices, get_varid_from_kind +use state_structure_mod, only : & + add_domain, get_dart_vector_index, get_domain_size, & + get_model_variable_indices, get_varid_from_kind use distributed_state_mod, only : get_state @@ -56,10 +63,11 @@ module model_mod ! To write model specific versions of these routines ! remove the routine from this use statement and add your code to ! this the file. -use default_model_mod, only : pert_model_copies, read_model_time, write_model_time, & - init_time => fail_init_time, & - init_conditions => fail_init_conditions, & - convert_vertical_obs, convert_vertical_state, adv_1step +use default_model_mod, only : & + pert_model_copies, read_model_time, write_model_time, & + init_time => fail_init_time, & + init_conditions => fail_init_conditions, & + convert_vertical_obs, convert_vertical_state, adv_1step implicit none private @@ -98,7 +106,7 @@ module model_mod integer :: dom_id ! used to access the state structure type(time_type) :: assimilation_time_step -!------------------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Default values for namelist ! TODO: replace model_nml:filter_io_filename with filter_io_root, ! so that namelist doesn't need to be changed for each member @@ -113,8 +121,8 @@ module model_mod ! integer, parameter :: NF90_MAX_NAME = 256 ! This module uses vtablenamelength instead (which is shorter = less white space output ! to diagnostics). -integer, parameter :: MAX_STATE_VARIABLES = 100 -integer, parameter :: NUM_STATE_TABLE_COLUMNS = 6 +integer, parameter :: MAX_STATE_VARIABLES = 100 +integer, parameter :: NUM_STATE_TABLE_COLUMNS = 6 character(len=vtablenamelength) :: variables(NUM_STATE_TABLE_COLUMNS,MAX_STATE_VARIABLES) = ' ' namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables @@ -134,7 +142,7 @@ module model_mod namelist /dart_to_aether_nml/ aether_restart_dirname, filter_io_root, variables, debug -!------------------------------------------------------------------------------- +!----------------------------------------------------------------------- ! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table ! VT_ORIGININDX is used differently from the usual domains context. ! It does not provide full path+filenames. Here it is used by aether_to_dart and @@ -147,16 +155,8 @@ module model_mod integer, parameter :: VT_ORIGININDX = 5 ! file of origin integer, parameter :: VT_STATEINDX = 6 ! ... update (state) or not -! to be assigned in assign_dimensions (for filter) -! or get_grid_from_blocks (aether_to_dart, dart_to_aether). -real(r8), allocatable :: levs(:), lats(:), lons(:) -! Can't just change this to r4. -! I'll need to read the dims from filter_input_0001.nc into r4 temp array, -! then convert to these r8 vars. - - -integer :: nlev, nlat, nlon -real(r8) :: lon_start, lon_delta, lat_start, lat_delta, lat_end +!----------------------------------------------------------------------- +! Dimensions ! TODO: using length * causes(?) a problem when calling nc_define_var_real_Nd ! with the list of dim_names in this order. nc_define also uses size * @@ -174,32 +174,45 @@ module model_mod character(len=4), parameter :: LON_VAR_NAME = 'lon' character(len=4), parameter :: TIME_VAR_NAME = 'time' +! Aether ! number of blocks along each dim -integer :: nblocks_lon=MISSING_I, nblocks_lat=MISSING_I, nblocks_lev=MISSING_I +integer :: nblocks_lon=MISSING_I, nblocks_lat=MISSING_I, nblocks_lev=MISSING_I +integer :: nx_per_block, ny_per_block, nz_per_block ! TODO: should nghost be read from the namelist? ! Aaron; not in the foreseeable future. -integer :: nx_per_block, ny_per_block, nz_per_block integer, parameter :: nghost = 2 ! number of ghost cells on all edges -!------------------------------------------------------------------------------- -integer :: aether_ref_day = 2451545.0 ! cJULIAN2000 in Aether = day of date 2000/01/01. -character(len=32) :: calendar = 'GREGORIAN' -! Day 0 in this calendar is (+/1 a day) -4710/11/24 0 UTC -! But what we care about is the ref time for the times in the files, which is 1965-1-1 00:00 +! Filter +! To be assigned in assign_dimensions (for filter) +! or get_grid_from_blocks (aether_to_dart, dart_to_aether). +real(r8), allocatable :: levs(:), lats(:), lons(:) +! TODO: Sort out the precision of levs... in filter_*.nc versus Aether restarts. +! Can't just change this to r4. +! I'll need to read the dims from filter_input_0001.nc into r4 temp array, +! then convert to these r8 vars. + +integer :: nlev, nlat, nlon +real(r8) :: lon_start, lon_delta, lat_start, lat_delta, lat_end + +!----------------------------------------------------------------------- +! Day 0 in Aether's calendar is (+/1 a day) -4710/11/24 0 UTC +! integer :: aether_ref_day = 2451545.0 ! cJULIAN2000 in Aether = day of date 2000/01/01. +character(len=32) :: calendar = 'GREGORIAN' +! But what we care about is the ref time for the times in the files, which is 1965-1-1 00:00 integer, dimension(:) :: aether_ref_date(5) = (/1965,1,1,0,0/) ! y,mo,d,h,m (secs assumed 0) type(time_type) :: aether_ref_time integer :: aether_ref_ndays, aether_ref_nsecs -!------------------------------------------------------------------------------- +!----------------------------------------------------------------------- ! to be assigned in the verify_variables subroutine -integer :: nvar, nvar_neutral, nvar_ion +integer :: nvar, nvar_neutral, nvar_ion character(len=vtablenamelength) :: var_names(MAX_STATE_VARIABLES) -real(r8) :: var_ranges(MAX_STATE_VARIABLES,2) -logical :: var_update(MAX_STATE_VARIABLES) -integer :: var_qtys(MAX_STATE_VARIABLES) +real(r8) :: var_ranges(MAX_STATE_VARIABLES,2) +logical :: var_update(MAX_STATE_VARIABLES) +integer :: var_qtys(MAX_STATE_VARIABLES) type(quad_interp_handle) :: quad_interp @@ -215,8 +228,7 @@ module model_mod contains -!------------------------------------------------------------------ -! +!----------------------------------------------------------------------- ! Called to do one time initialization of the model. As examples, ! might define information about the model size or model timestep. ! In models that require pre-computed static data, for instance @@ -248,9 +260,9 @@ subroutine static_init_model() ! Dimension start and deltas needed for set_quad_coords lon_start = lons(1) -lon_delta = lons(2)-lons(1) +lon_delta = lons(2) - lons(1) lat_start = lats(1) -lat_delta = lats(2)-lats(1) +lat_delta = lats(2) - lats(1) call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) @@ -259,16 +271,14 @@ subroutine static_init_model() ! window. All observations within +/- 1/2 this interval from the current ! model time will be assimilated. If this is not settable at runtime ! feel free to hardcode it and remove from the namelist. -assimilation_time_step = set_time(time_step_seconds, & - time_step_days) - +assimilation_time_step = set_time(time_step_seconds, time_step_days) ! Define which variables are in the model state ! This is using add_domain_from_file (arg list matches) dom_id = add_domain(filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) -call init_quad_interp(GRID_QUAD_FULLY_REGULAR, nlon, nlat, & - QUAD_LOCATED_CELL_CENTERS, & +call init_quad_interp(GRID_QUAD_FULLY_REGULAR, nlon, nlat, & + QUAD_LOCATED_CELL_CENTERS, & global=.true., spans_lon_zero=.true., pole_wrap=.true., & interp_handle=quad_interp) @@ -276,7 +286,7 @@ subroutine static_init_model() end subroutine static_init_model -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! Returns the number of items in the state vector as an integer. function get_model_size() @@ -290,101 +300,102 @@ function get_model_size() end function get_model_size !----------------------------------------------------------------------- +! Use quad_utils_mod to interpalate the ensemble to the ob location. subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs, istatus) - type(ensemble_type), intent(in) :: state_handle - integer, intent(in) :: ens_size - type(location_type), intent(in) :: location - integer, intent(in) :: qty - real(r8), intent(out) :: expected_obs(ens_size) - integer, intent(out) :: istatus(ens_size) - - ! Local storage - - character(len=*), parameter :: routine = 'model_interpolate' - - real(r8) :: loc_array(3), llon, llat, lvert, lon_fract, lat_fract - integer :: four_lons(4), four_lats(4) - integer :: status1, which_vert, varid - real(r8) :: quad_vals(4, ens_size) - - if ( .not. module_initialized ) call static_init_model - - ! Assume failure. Set return val to missing, then the code can - ! just set istatus to something indicating why it failed, and return. - ! If the interpolation is good, expected_obs will be set to the - ! good values, and the last line here sets istatus to 0. - ! make any error codes set here be in the 10s - - expected_obs = MISSING_R8 ! the DART bad value flag - istatus = GENERAL_ERROR_CODE ! unknown error - - ! Get the individual locations values - - loc_array = get_location(location) - llon = loc_array(1) - llat = loc_array(2) - lvert = loc_array(3) - which_vert = nint(query_location(location)) - - IF (debug > 85) then - write(error_string_1,*) 'requesting interpolation at ', llon, llat, lvert - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - end if - - ! Only height and level for vertical location type is supported at this point - if (.not. is_vertical(location, "HEIGHT") .and. .not. is_vertical(location, "LEVEL")) THEN - istatus = INVALID_VERT_COORD_ERROR_CODE - return - endif - - if (qty == QTY_GEOMETRIC_HEIGHT .and. is_vertical(location, "LEVEL")) then - if (nint(lvert) < 1 .or. nint(lvert) > size(levs,1)) then - expected_obs = MISSING_R8 - istatus = 1 - else - expected_obs = levs(nint(lvert)) - istatus = 0 - endif - return ! Early Return - endif - - ! do we know how to interpolate this quantity? - call ok_to_interpolate(qty, varid, status1) - - if (status1 /= 0) then - if(debug > 12) then - write(error_string_1,*) 'Did not find observation quantity ', qty, ' in the state vector' - call error_handler(E_WARN,routine,error_string_1,source,revision,revdate) - endif - istatus(:) = status1 ! this quantity not in the state vector - return - 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(quad_interp, llon, llat, & - four_lons, four_lats, lon_fract, lat_fract, status1) - if (status1 /= 0) then - istatus(:) = INVALID_LATLON_VAL_ERROR_CODE ! cannot locate enclosing horizontal quad - return - endif - - call get_quad_vals(state_handle, ens_size, varid, four_lons, four_lats, & - loc_array, which_vert, quad_vals, istatus) - if (any(istatus /= 0)) return - - ! do the horizontal interpolation for each ensemble member - call quad_lon_lat_evaluate(quad_interp, lon_fract, lat_fract, ens_size, & - quad_vals, expected_obs, istatus) - - ! All good. - istatus(:) = 0 +type(ensemble_type), intent(in) :: state_handle +integer, intent(in) :: ens_size +type(location_type), intent(in) :: location +integer, intent(in) :: qty +real(r8), intent(out) :: expected_obs(ens_size) +integer, intent(out) :: istatus(ens_size) + +! Local storage + +character(len=*), parameter :: routine = 'model_interpolate' + +real(r8) :: loc_array(3), llon, llat, lvert, lon_fract, lat_fract +integer :: four_lons(4), four_lats(4) +integer :: status1, which_vert, varid +real(r8) :: quad_vals(4, ens_size) + +if ( .not. module_initialized ) call static_init_model + +! Assume failure. Set return val to missing, then the code can +! just set istatus to something indicating why it failed, and return. +! If the interpolation is good, expected_obs will be set to the +! good values, and the last line here sets istatus to 0. +! make any error codes set here be in the 10s + +expected_obs = MISSING_R8 ! the DART bad value flag +istatus = GENERAL_ERROR_CODE ! unknown error + +! Get the individual locations values + +loc_array = get_location(location) +llon = loc_array(1) +llat = loc_array(2) +lvert = loc_array(3) +which_vert = nint(query_location(location)) + +IF (debug > 85) then + write(error_string_1,*) 'requesting interpolation at ', llon, llat, lvert + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +end if + +! Only height and level for vertical location type is supported at this point +if (.not. is_vertical(location, "HEIGHT") .and. .not. is_vertical(location, "LEVEL")) THEN + istatus = INVALID_VERT_COORD_ERROR_CODE + return +endif + +if (qty == QTY_GEOMETRIC_HEIGHT .and. is_vertical(location, "LEVEL")) then + if (nint(lvert) < 1 .or. nint(lvert) > size(levs,1)) then + expected_obs = MISSING_R8 + istatus = 1 + else + expected_obs = levs(nint(lvert)) + istatus = 0 + endif + return ! Early Return +endif + +! do we know how to interpolate this quantity? +call ok_to_interpolate(qty, varid, status1) + +if (status1 /= 0) then + if(debug > 12) then + write(error_string_1,*) 'Did not find observation quantity ', qty, ' in the state vector' + call error_handler(E_WARN, routine, error_string_1, source, revision, revdate) + endif + istatus(:) = status1 ! this quantity not in the state vector + return +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(quad_interp, llon, llat, & + four_lons, four_lats, lon_fract, lat_fract, status1) +if (status1 /= 0) then + istatus(:) = INVALID_LATLON_VAL_ERROR_CODE ! cannot locate enclosing horizontal quad + return +endif + +call get_quad_vals(state_handle, ens_size, varid, four_lons, four_lats, & + loc_array, which_vert, quad_vals, istatus) +if (any(istatus /= 0)) return + +! do the horizontal interpolation for each ensemble member +call quad_lon_lat_evaluate(quad_interp, lon_fract, lat_fract, ens_size, & + quad_vals, expected_obs, istatus) + +! All good. +istatus(:) = 0 end subroutine model_interpolate -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! Returns the smallest increment in time that the model is capable ! of advancing the state in a given implementation, or the shortest ! time you want the model to advance between assimilations. @@ -401,7 +412,7 @@ end function shortest_time_between_assimilations -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! Given an integer index into the state vector, returns the ! associated location and optionally the physical quantity. @@ -409,7 +420,7 @@ subroutine get_state_meta_data(index_in, location, qty) integer(i8), intent(in) :: index_in type(location_type), intent(out) :: location -integer, intent(out), optional :: qty +integer, optional , intent(out) :: qty character(len=*), parameter :: routine = 'get_state_meta_data' @@ -422,7 +433,7 @@ subroutine get_state_meta_data(index_in, location, qty) ! Restart data is ordered (lev,lat,lon) (translated from C to fortran). call get_model_variable_indices(index_in, lev_index, lat_index, lon_index, & - var_id=my_var_id, kind_index=my_qty) + var_id=my_var_id, kind_index=my_qty) ! should be set to the actual location using set_location() location = set_location(lons(lon_index), lats(lat_index), levs(lev_index), VERTISHEIGHT) @@ -433,7 +444,7 @@ subroutine get_state_meta_data(index_in, location, qty) end subroutine get_state_meta_data -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! Any model specific distance calcualtion can be done here subroutine get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & @@ -453,11 +464,11 @@ subroutine get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & character(len=*), parameter :: routine = 'get_close_obs' call loc_get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & - num_close, close_ind, dist, ens_handle) + num_close, close_ind, dist, ens_handle) end subroutine get_close_obs -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! Any model specific distance calcualtion can be done here subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & @@ -478,11 +489,11 @@ subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & - num_close, close_ind, dist, ens_handle) + num_close, close_ind, dist, ens_handle) end subroutine get_close_state -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! Does any shutdown and clean-up needed for model. Can be a NULL ! INTERFACE if the model has no need to clean up storage, etc. @@ -490,13 +501,14 @@ subroutine end_model() end subroutine end_model -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! write any additional attributes to the output and diagnostic files subroutine nc_write_model_atts(ncid, domain_id) integer, intent(in) :: ncid ! netCDF file identifier integer, intent(in) :: domain_id + character(len=*), parameter :: routine = 'nc_write_model_atts' if ( .not. module_initialized ) call static_init_model @@ -519,7 +531,7 @@ subroutine nc_write_model_atts(ncid, domain_id) end subroutine nc_write_model_atts -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! Add dimension variable contents to the file. subroutine def_fill_dimvars(ncid) @@ -576,190 +588,189 @@ subroutine def_fill_dimvars(ncid) end subroutine def_fill_dimvars -!------------------------------------------------------------------ +!----------------------------------------------------------------------- ! Read dimension information from the template file and use ! it to assign values to variables. subroutine assign_dimensions(filter_io_filename, levs, lats, lons, nlev, nlat, nlon) +character(len=*), intent(in) :: filter_io_filename +real(r8), allocatable, intent(out) :: levs(:), lats(:), lons(:) +integer, intent(out) :: nlev, nlat, nlon - character(len=*), intent(in) :: filter_io_filename - real(r8), allocatable, intent(out) :: levs(:), lats(:), lons(:) - integer, intent(out) :: nlev, nlat, nlon - - integer :: ncid - character(len=24), parameter :: ROUTINE = 'assign_dimensions' +integer :: ncid +character(len=24), parameter :: ROUTINE = 'assign_dimensions' - call error_handler(E_MSG, ROUTINE, 'reading filter input ['//trim(filter_io_filename)//']') +call error_handler(E_MSG, ROUTINE, 'reading filter input ['//trim(filter_io_filename)//']') - ncid = nc_open_file_readonly(filter_io_filename, ROUTINE) +ncid = nc_open_file_readonly(filter_io_filename, ROUTINE) - ! levels - nlev = nc_get_dimension_size(ncid, trim(LEV_DIM_NAME), ROUTINE) - allocate(levs(nlev)) - call nc_get_variable(ncid, trim(LEV_VAR_NAME), levs, ROUTINE) +! levels +nlev = nc_get_dimension_size(ncid, trim(LEV_DIM_NAME), ROUTINE) +allocate(levs(nlev)) +call nc_get_variable(ncid, trim(LEV_VAR_NAME), levs, ROUTINE) - ! latitiude - nlat = nc_get_dimension_size(ncid, trim(LAT_DIM_NAME), ROUTINE) - allocate(lats(nlat)) - call nc_get_variable(ncid, trim(LAT_VAR_NAME), lats, ROUTINE) +! latitiude +nlat = nc_get_dimension_size(ncid, trim(LAT_DIM_NAME), ROUTINE) +allocate(lats(nlat)) +call nc_get_variable(ncid, trim(LAT_VAR_NAME), lats, ROUTINE) - ! longitude - nlon = nc_get_dimension_size(ncid, trim(LON_DIM_NAME), ROUTINE) - allocate(lons(nlon)) - call nc_get_variable(ncid, trim(LON_VAR_NAME), lons, ROUTINE) +! longitude +nlon = nc_get_dimension_size(ncid, trim(LON_DIM_NAME), ROUTINE) +allocate(lons(nlon)) +call nc_get_variable(ncid, trim(LON_VAR_NAME), lons, ROUTINE) end subroutine assign_dimensions -!-------------------------------------------------------------------- - +!----------------------------------------------------------------------- +! Parse the table of variables' characteristics into arrays for easier access. subroutine verify_variables(variables, file, nvar, & - var_names, var_qtys, var_ranges, var_update) + var_names, var_qtys, var_ranges, var_update) - character(len=*), intent(in) :: variables(:,:) - character(len=*), intent(inout) :: file - integer, intent(out) :: nvar - character(len=*), intent(out) :: var_names(:) - real(r8), intent(out) :: var_ranges(:,:) - logical, intent(out) :: var_update(:) - integer, intent(out) :: var_qtys(:) +character(len=*), intent(in) :: variables(:,:) +character(len=*), intent(inout) :: file +integer, intent(out) :: nvar +character(len=*), intent(out) :: var_names(:) +real(r8), intent(out) :: var_ranges(:,:) +logical, intent(out) :: var_update(:) +integer, intent(out) :: var_qtys(:) - character(len=*), parameter :: routine = 'verify_variables' +character(len=*), parameter :: routine = 'verify_variables' - integer :: io, i, quantity - real(r8) :: minvalue, maxvalue +integer :: io, i, quantity +real(r8) :: minvalue, maxvalue - character(len=vtablenamelength) :: varname - character(len=vtablenamelength) :: dartstr - character(len=vtablenamelength) :: minvalstring - character(len=vtablenamelength) :: maxvalstring - character(len=vtablenamelength) :: state_or_aux +character(len=vtablenamelength) :: varname +character(len=vtablenamelength) :: dartstr +character(len=vtablenamelength) :: minvalstring +character(len=vtablenamelength) :: maxvalstring +character(len=vtablenamelength) :: state_or_aux - nvar = 0 - MyLoop : do i = 1, size(variables,2) +nvar = 0 +MyLoop : do i = 1, size(variables,2) ! TODO Why define these intermediate strings? Is the code clearer or faster? - varname = variables(VT_VARNAMEINDX,i) - dartstr = variables(VT_KINDINDX,i) - minvalstring = variables(VT_MINVALINDX,i) - maxvalstring = variables(VT_MAXVALINDX,i) - state_or_aux = variables(VT_STATEINDX,i) - - if ( varname == ' ' .and. dartstr == ' ' ) exit MyLoop ! Found end of list. - - if ( varname == ' ' .or. dartstr == ' ' ) then - error_string_1 = 'model_nml: variable list not fully specified' - error_string_2 = 'reading from "'//trim(filter_io_filename)//'"' - call error_handler(E_ERR,routine, error_string_1, & - source, revision, revdate, text2=error_string_2) - endif - - ! The internal DART routines check if the variable name is valid. - - ! Make sure DART kind is valid - quantity = get_index_for_quantity(dartstr) - if( quantity < 0 ) then - write(error_string_1,'(''there is no obs_kind "'',a,''" in obs_kind_mod.f90'')') & - trim(dartstr) - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) - endif - - ! All good to here - fill the output variables - - nvar = nvar + 1 - if (variables(VT_ORIGININDX,i) == 'neutrals') nvar_neutral = nvar_neutral+1 - if (variables(VT_ORIGININDX,i) == 'ions') nvar_ion = nvar_ion+1 - var_names( nvar) = varname - var_qtys( nvar) = quantity - var_ranges(nvar,:) = (/ MISSING_R8, MISSING_R8 /) - var_update(nvar) = .false. ! at least initially - - ! convert the [min,max]valstrings to numeric values if possible - read(minvalstring,*,iostat=io) minvalue - if (io == 0) var_ranges(nvar,1) = minvalue - - read(maxvalstring,*,iostat=io) maxvalue - if (io == 0) var_ranges(nvar,2) = maxvalue - - call to_upper(state_or_aux) - if (state_or_aux == 'UPDATE') var_update(nvar) = .true. - - enddo MyLoop + varname = variables(VT_VARNAMEINDX,i) + dartstr = variables(VT_KINDINDX,i) + minvalstring = variables(VT_MINVALINDX,i) + maxvalstring = variables(VT_MAXVALINDX,i) + state_or_aux = variables(VT_STATEINDX,i) + + if ( varname == ' ' .and. dartstr == ' ' ) exit MyLoop ! Found end of list. + + if ( varname == ' ' .or. dartstr == ' ' ) then + error_string_1 = 'model_nml: variable list not fully specified' + error_string_2 = 'reading from "'//trim(filter_io_filename)//'"' + call error_handler(E_ERR, routine, error_string_1, & + source, revision, revdate, text2=error_string_2) + endif + + ! The internal DART routines check if the variable name is valid. + + ! Make sure DART kind is valid + quantity = get_index_for_quantity(dartstr) + if( quantity < 0 ) then + write(error_string_1,'(''there is no obs_kind "'',a,''" in obs_kind_mod.f90'')') & + trim(dartstr) + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + endif + + ! All good to here - fill the output variables + + nvar = nvar + 1 + if (variables(VT_ORIGININDX,i) == 'neutrals') nvar_neutral = nvar_neutral + 1 + if (variables(VT_ORIGININDX,i) == 'ions') nvar_ion = nvar_ion + 1 + var_names( nvar) = varname + var_qtys( nvar) = quantity + var_ranges(nvar,:) = (/ MISSING_R8, MISSING_R8 /) + var_update(nvar) = .false. ! at least initially + + ! convert the [min,max]valstrings to numeric values if possible + read(minvalstring,*,iostat=io) minvalue + if (io == 0) var_ranges(nvar,1) = minvalue + + read(maxvalstring,*,iostat=io) maxvalue + if (io == 0) var_ranges(nvar,2) = maxvalue + + call to_upper(state_or_aux) + if (state_or_aux == 'UPDATE') var_update(nvar) = .true. - if (nvar == MAX_STATE_VARIABLES) then - error_string_1 = 'WARNING: you may need to increase "MAX_STATE_VARIABLES"' - write(error_string_2,'(''you have specified at least '',i4,'' perhaps more.'')') nvar - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate,text2=error_string_2) - endif +enddo MyLoop + +if (nvar == MAX_STATE_VARIABLES) then + error_string_1 = 'WARNING: you may need to increase "MAX_STATE_VARIABLES"' + write(error_string_2,'(''you have specified at least '',i4,'' perhaps more.'')') nvar + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate, text2=error_string_2) +endif end subroutine verify_variables -!-------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Extract state values needed by the interpolation from all ensemble members. subroutine get_quad_vals(state_handle, ens_size, varid, four_lons, four_lats, & - lon_lat_vert, which_vert, quad_vals, istatus) - - type(ensemble_type), intent(in) :: state_handle - integer, intent(in) :: ens_size - integer, intent(in) :: varid - integer, intent(in) :: four_lons(4), 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) - integer, intent(out) :: istatus(ens_size) - - real(r8) :: vert_val - integer :: lev1, lev2, stat, integer_level - real(r8) :: vert_fract - character(len=512) :: error_string_1 - - character(len=*), parameter :: routine = 'get_quad_vals' - - quad_vals(:,:) = MISSING_R8 - istatus(:) = GENERAL_ERROR_CODE - - vert_val = lon_lat_vert(3) - - if ( which_vert == VERTISHEIGHT ) then - call find_enclosing_indices(nlev, levs(:), vert_val, lev1, lev2, & - vert_fract, stat, log_scale = .false.) - - if (stat /= 0) then - istatus = INVALID_ALTITUDE_VAL_ERROR_CODE - end if - else - istatus(:) = INVALID_VERT_COORD_ERROR_CODE - write(error_string_1, *) 'unsupported vertical type: ', which_vert - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) - endif - - ! 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, & - lev1, lev2, vert_fract, varid, quad_vals, & - istatus) - else - write(error_string_1, *) 'unsupported variable: ', varid - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) - endif - - if (any(istatus /= 0)) return - - ! when you get here, istatus() was set either by passing it to a - ! subroutine, or setting it explicitly here. + lon_lat_vert, which_vert, quad_vals, istatus) + +type(ensemble_type), intent(in) :: state_handle +integer, intent(in) :: ens_size +integer, intent(in) :: varid +integer, intent(in) :: four_lons(4), 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) +integer, intent(out) :: istatus(ens_size) + +real(r8) :: vert_val +integer :: lev1, lev2, stat, integer_level +real(r8) :: vert_fract +character(len=512) :: error_string_1 + +character(len=*), parameter :: routine = 'get_quad_vals' + +quad_vals(:,:) = MISSING_R8 +istatus(:) = GENERAL_ERROR_CODE + +vert_val = lon_lat_vert(3) + +if ( which_vert == VERTISHEIGHT ) then + call find_enclosing_indices(nlev, levs(:), vert_val, lev1, lev2, & + vert_fract, stat, log_scale = .false.) + + if (stat /= 0) then + istatus = INVALID_ALTITUDE_VAL_ERROR_CODE + end if +else + istatus(:) = INVALID_VERT_COORD_ERROR_CODE + write(error_string_1, *) 'unsupported vertical type: ', which_vert + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +endif + +! 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, & + lev1, lev2, vert_fract, varid, quad_vals, istatus) +else + write(error_string_1, *) 'unsupported variable: ', varid + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +endif + +if (any(istatus /= 0)) return + +! when you get here, istatus() was set either by passing it to a +! subroutine, or setting it explicitly here. end subroutine get_quad_vals !----------------------------------------------------------------------- -!> 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 +! 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 subroutine vert_interp(nitems, levs1, levs2, vert_fract, out_vals) @@ -769,609 +780,615 @@ subroutine vert_interp(nitems, levs1, levs2, vert_fract, out_vals) real(r8), intent(in) :: vert_fract real(r8), intent(out) :: out_vals(nitems) -out_vals(:) = (levs1(:) * (1.0_r8-vert_fract)) + & -(levs2(:) * vert_fract) +out_vals(:) = (levs1(:) * (1.0_r8 - vert_fract)) + & + (levs2(:) * vert_fract ) end subroutine vert_interp -!-------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Extract the state values at the corners of the 2 quads used for interpolation. subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & - lev1, lev2, vert_fract, varid, quad_vals, & - istatus) - - type(ensemble_type), intent(in) :: state_handle - integer, intent(in) :: ens_size - integer, intent(in) :: four_lons(4), four_lats(4) - integer, intent(in) :: lev1, lev2 - real(r8), intent(in) :: vert_fract - integer, intent(in) :: varid - real(r8), intent(out) :: quad_vals(4, ens_size) !< array of interpolated values - integer, intent(out) :: istatus(ens_size) + lev1, lev2, vert_fract, varid, quad_vals, istatus) + +type(ensemble_type), intent(in) :: state_handle +integer, intent(in) :: ens_size +integer, intent(in) :: four_lons(4), four_lats(4) +integer, intent(in) :: lev1, lev2 +real(r8), intent(in) :: vert_fract +integer, intent(in) :: varid +real(r8), intent(out) :: quad_vals(4, ens_size) !< array of interpolated values +integer, intent(out) :: istatus(ens_size) + +integer :: icorner +integer(i8) :: state_indx +real(r8) :: vals1(ens_size), vals2(ens_size) +real(r8) :: qvals(ens_size) + +character(len=*), parameter :: routine = 'get_four_state_values:' + +do icorner = 1, 4 + + ! Most rapidly varying dim must be first + state_indx = get_dart_vector_index(lev1, four_lats(icorner), & + four_lons(icorner), dom_id, varid) + + if (state_indx < 0) then + write(error_string_1,*) 'Could not find dart state index from ' + write(error_string_2,*) 'lon, lat, and lev1 index :', & + four_lons(icorner), four_lats(icorner), lev1 + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate, & + text2=error_string_2) + return + endif - integer :: icorner - real(r8) :: vals1(ens_size), vals2(ens_size) - real(r8) :: qvals(ens_size) + vals1(:) = get_state(state_indx, state_handle) ! all the ensemble members for level (i) - integer(i8) :: state_indx + state_indx = get_dart_vector_index(lev2, four_lats(icorner), & + four_lons(icorner), dom_id, varid) - character(len=*), parameter :: routine = 'get_four_state_values:' + if (state_indx < 0) then + write(error_string_1,*) 'Could not find dart state index from ' + write(error_string_2,*) 'lon, lat, and lev2 index :', & + four_lons(icorner), four_lats(icorner), lev2 + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate, & + text2=error_string_2) + return + endif - do icorner=1, 4 + vals2(:) = get_state(state_indx, state_handle) ! all the ensemble members for level (i) - ! Most rapidly varying dim must be first - state_indx = get_dart_vector_index(lev1 ,four_lats(icorner), & - four_lons(icorner), dom_id, varid) - - if (state_indx < 0) then - write(error_string_1,*) 'Could not find dart state index from ' - write(error_string_2,*) 'lon, lat, and lev1 index :', four_lons(icorner), four_lats(icorner), & - lev1 - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate,text2=error_string_2) - return - endif - - vals1(:) = get_state(state_indx, state_handle) ! all the ensemble members for level (i) - - state_indx = get_dart_vector_index(lev2, four_lats(icorner), & - four_lons(icorner), dom_id, varid) - - if (state_indx < 0) then - write(error_string_1,*) 'Could not find dart state index from ' - write(error_string_2,*) 'lon, lat, and lev2 index :', four_lons(icorner), four_lats(icorner), lev2 - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate,text2=error_string_2) - return - endif - - vals2(:) = get_state(state_indx, state_handle) ! all the ensemble members for level (i) - - ! if directly using quad_vals here, it would create a temporary array and give a warning - call vert_interp(ens_size, vals1, vals2, vert_fract, qvals) - quad_vals(icorner, :) = qvals - enddo + ! if directly using quad_vals here, it would create a temporary array and give a warning + call vert_interp(ens_size, vals1, vals2, vert_fract, qvals) + quad_vals(icorner, :) = qvals +enddo - istatus = 0 +istatus = 0 end subroutine get_four_state_values -!================================================================== - -!> 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 +!----------------------------------------------------------------------- +! 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 subroutine ok_to_interpolate(qty, varid, istatus) - integer, intent(in) :: qty - integer, intent(out) :: varid - integer, intent(out) :: istatus - - ! See if the state contains the obs quantity - varid = get_varid_from_kind(dom_id, qty) - - ! in the state vector - if (varid > 0) then - istatus = 0 - return - endif - - ! add any quantities that can be interpolated to this list if they - ! are not in the state vector. - select case (qty) - case (QTY_GEOMETRIC_HEIGHT) - istatus = 0 - case default - istatus = UNKNOWN_OBS_QTY_ERROR_CODE - end select +integer, intent(in) :: qty +integer, intent(out) :: varid +integer, intent(out) :: istatus + +! See if the state contains the obs quantity +varid = get_varid_from_kind(dom_id, qty) + +! in the state vector +if (varid > 0) then + istatus = 0 + return +endif + +! add any quantities that can be interpolated to this list if they +! are not in the state vector. +select case (qty) + case (QTY_GEOMETRIC_HEIGHT) + istatus = 0 + case default + istatus = UNKNOWN_OBS_QTY_ERROR_CODE +end select end subroutine ok_to_interpolate -!-------------------------------------------------------------------- -!> Converts Aether restart files to a netCDF file -!> -!> This routine needs: -!> -!> 1. A base dirname for the restart files (restart_dirname). -!> they will have the format 'dirname/{neutrals,ions}_mMMMM_gBBBB.rst' -!> where BBBB is the block number, MMMM is the member number, -!> and they have leading 0s. Blocks start in the -!> southwest corner of the lat/lon grid and go east first, -!> then to the west end of the next row north and end in the northeast corner. -!> -!> In the process, the routine will find: -!> -!> 1. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. -!> (nBlocksLon, nBlocksLat, 1) -!> -!> 2. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) -!> -!> 3. The number of lon/lats in a single grid block (nxPerBlock, -!> nyPerBlock, nzPerBlock) -!> -!> 4. The number of neutral species (and probably a mapping between -!> the species number and the variable name) (nSpeciesTotal, nSpecies) -!> -!> 5. The number of ion species (ditto - numbers <-> names) (nIons) -!> -!> In addition to reading in the state data, it fills Longitude, Latitude, and Altitude arrays. -!> This grid is orthogonal and rectangular but can have irregular spacing along -!> any of the three dimensions. +!----------------------------------------------------------------------- +! Converts Aether restart files to a netCDF file +! +! This routine needs: +! +! 1. A base dirname for the restart files (aether_restart_dirname). +! The filenames have the format 'dirname/{neutrals,ions}_mMMMM_gBBBB.rst' +! where BBBB is the block number, MMMM is the member number, +! and they have leading 0s. Blocks start in the +! southwest corner of the lat/lon grid and go east first, +! then to the west end of the next row north and end in the northeast corner. +! +! In the process, the routine will find: +! +! 1. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) +! +! 2. The number of lons and lats in a single grid block (nxPerBlock, nyPerBlock, nzPerBlock) +! +! 3. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. +! +! 4. The number of neutral species (and probably a mapping between +! the species number and the variable name) (nvar_neutral) +! +! 5. The number of ion species (ditto - numbers <-> names) (nvar_ion) +! +! In addition to reading in the state data, it fills Longitude, Latitude, and Altitude arrays. +! This grid is orthogonal and rectangular but can have irregular spacing along +! any of the three dimensions. subroutine restart_files_to_netcdf(member) - integer, intent(in) :: member - - integer :: ncid - - character(len=*), parameter :: routine = 'restart_files_to_netcdf' - - if (module_initialized ) then - write(error_string_1,*)'The aether static_init_model was already initialized but ',trim(routine),& - ' uses a separate initialization procedure' - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) - end if - - call static_init_blocks("aether_to_dart_nml") - - write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member+1,'.nc' - ! nc_create_file does not leave define mode - ncid = nc_create_file(filter_io_filename) - - call error_handler(E_MSG, '', '') - write(error_string_1,*) 'converting Aether restart files in directory ', & - "'"//trim(aether_restart_dirname)//"'" - write(error_string_2,*) ' to the NetCDF file ', "'"//trim(filter_io_filename)//"'" - call error_handler(E_MSG, routine, error_string_1, text2=error_string_2) - call error_handler(E_MSG, '', '') - - ! TODO: we haven't settled on the mechanism for identifying the state vector field names and source. - ! (defined type, arrays, named indices,...) - ! TODO: def_fill_dimvars functionality was in nc_write_model_atts but shouldn't have been. - ! I separated nc_write_model_atts into to parts and this is one of them. - ! Is this the best place for the call? It's in the "define" section for the filter_input file. - ! It works. - call def_fill_dimvars(ncid) - - ! Write_model_time will make a time variable, if needed, which it is not. - call write_model_time(ncid, state_time) - - ! Define (non-time) variables - call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) - - ! Read and convert (non-time) variables - call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) - ! subr. called by this routine closes the file only if define = .true. - call nc_close_file(ncid) - - call error_handler(E_MSG, '', '') - write(error_string_1,*) 'Successfully converted the Aether restart files to ', & - "'"//trim(filter_io_filename)//"'" - call error_handler(E_MSG, routine, error_string_1) - call error_handler(E_MSG, '', '') - +integer, intent(in) :: member + +integer :: ncid + +character(len=*), parameter :: routine = 'restart_files_to_netcdf' + +if (module_initialized ) then + write(error_string_1,*)'The aether static_init_model was already initialized but ', & + trim(routine), ' uses a separate initialization procedure' + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +end if + +call static_init_blocks("aether_to_dart_nml") + +write(filter_io_filename,'(2A, I0.4, A3)') trim(filter_io_root),'_', member + 1,'.nc' +! nc_create_file does not leave define mode +ncid = nc_create_file(filter_io_filename) + +call error_handler(E_MSG, '', '') +write(error_string_1,*) 'converting Aether restart files in directory ', & + "'"//trim(aether_restart_dirname)//"'" +write(error_string_2,*) ' to the NetCDF file ', "'"//trim(filter_io_filename)//"'" +call error_handler(E_MSG, routine, error_string_1, text2=error_string_2) +call error_handler(E_MSG, '', '') + +! TODO: we haven't settled on the mechanism for identifying the state vector field names and source. +! (defined type, arrays, named indices,...) +! TODO: def_fill_dimvars functionality was in nc_write_model_atts but shouldn't have been. +! I separated nc_write_model_atts into to parts and this is one of them. +! Is this the best place for the call? It's in the "define" section for the filter_input file. +! It works. +call def_fill_dimvars(ncid) + +! Write_model_time will make a time variable, if needed, which it is not. +call write_model_time(ncid, state_time) + +! Define (non-time) variables +call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) + +! Read and convert (non-time) variables +call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) +! subr. called by this routine closes the file only if define = .true. +call nc_close_file(ncid) + +call error_handler(E_MSG, '', '') +write(error_string_1,*) 'Successfully converted the Aether restart files to ', & + "'"//trim(filter_io_filename)//"'" +call error_handler(E_MSG, routine, error_string_1) +call error_handler(E_MSG, '', '') end subroutine restart_files_to_netcdf -!================================================================= -! Writes the current time and state variables from a dart state -! vector (1d array) into Aether netcdf restart file sets. +!----------------------------------------------------------------------- +! Writes the state variables from a dart state vector (1d array) +! into Aether netcdf restart file sets. subroutine netcdf_to_restart_files(member) - integer, intent(in) :: member - - integer :: ncid - character(len=*), parameter :: routine = 'netcdf_to_restart_files:' +integer, intent(in) :: member + +integer :: ncid +character(len=*), parameter :: routine = 'netcdf_to_restart_files:' ! write out the state vector data. ! when this routine returns all the data has been written. - if (module_initialized ) then - write(error_string_1,*)'The aether mod was already initialized but ',trim(routine),& - ' uses a separate initialization procedure' - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) - end if - - call static_init_blocks("dart_to_aether_nml") - - write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member+1,'.nc' - - call error_handler(E_MSG,routine,'','',revision,revdate) - write(error_string_1,*) 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" - write(error_string_2,*) 'into Aether restart files in directory ', "'"//trim(aether_restart_dirname)//"'" - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate,text2=error_string_2) - - ncid = nc_open_file_readonly(filter_io_filename, routine) - - call filter_to_restarts(ncid, member) - - !---------------------------------------------------------------------- - ! Log what we think we're doing, and exit. - !---------------------------------------------------------------------- - call error_handler(E_MSG,routine,'','',revision,revdate) - write(error_string_1,*) 'Successfully converted to the Aether restart files in directory' - write(error_string_2,*) "'"//trim(aether_restart_dirname)//"'" - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate,text2=error_string_2) - - call nc_close_file(ncid) +if (module_initialized ) then + write(error_string_1,*)'The aether mod was already initialized but ', & + trim(routine), ' uses a separate initialization procedure' + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +end if + +call static_init_blocks("dart_to_aether_nml") + +write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member + 1,'.nc' + +call error_handler(E_MSG, routine, '', '', revision, revdate) +write(error_string_1,*) 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" +write(error_string_2,*) 'into Aether restart files in directory ', & + "'"//trim(aether_restart_dirname)//"'" +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate, text2=error_string_2) + +ncid = nc_open_file_readonly(filter_io_filename, routine) + +call filter_to_restarts(ncid, member) + +!---------------------------------------------------------------------- +! Log what we think we're doing, and exit. +!---------------------------------------------------------------------- +call error_handler(E_MSG, routine,'','', revision, revdate) +write(error_string_1,*) 'Successfully converted to the Aether restart files in directory' +write(error_string_2,*) "'"//trim(aether_restart_dirname)//"'" +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate, text2=error_string_2) + +call nc_close_file(ncid) end subroutine netcdf_to_restart_files -!-------------------------------------------------------------------- +!----------------------------------------------------------------------- +! ? Will this need to open the grid_{below,corners,down,left} filetypes? +! This code can handle it; a longer filetype passed in, and no member. +! ? Aether output files? function block_file_name(filetype, memnum, blocknum) - character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} - ! ? Will this need to open the grid_{below,corners,down,left} filetypes? - ! This code can handle it; a longer filetype passed in, and no member. - ! ? Aether output files? - integer, intent(in) :: blocknum - integer, intent(in) :: memnum - character(len=128) :: block_file_name - character(len=*), parameter :: routine = 'block_file_name' - - block_file_name = trim(filetype) - if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum - if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum - block_file_name = trim(block_file_name)//'.nc' - if ( debug > 0 ) then - write(error_string_1,'("filename, memnum, blocknum = ",A,2(1x,i5))') & - trim(block_file_name), memnum, blocknum - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif +character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} +integer, intent(in) :: blocknum +integer, intent(in) :: memnum +character(len=128) :: block_file_name + +character(len=*), parameter :: routine = 'block_file_name' + +block_file_name = trim(filetype) +if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum +if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum +block_file_name = trim(block_file_name)//'.nc' +if ( debug > 0 ) then + write(error_string_1,'("filename, memnum, blocknum = ",A,2(1x,i5))') & + trim(block_file_name), memnum, blocknum + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +endif end function block_file_name -!-------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Like static_init_model, but for aether_to_dart and dart_to_aether. +! Read the namelist, +! parse the 'variables' table, +! get the Aether grid information +! convert the Aether time into a DART time. subroutine static_init_blocks(nml) - character(len=*), intent(in) :: nml - - character(len=128) :: aether_filter_io_filename - - character(len=*), parameter :: routine = 'static_init_blocks' - - character(len=vtablenamelength) :: varname - integer :: iunit, io, ivar - - if (module_initialized) return ! only need to do this once - - ! This prevents subroutines called from here from calling static_init_mod. - module_initialized = .true. - - !---------------------------------------------------------------------- - ! Read the namelist - - call find_namelist_in_file("input.nml", trim(nml), iunit) - if (trim(nml) == 'aether_to_dart_nml') then - read(iunit, nml = aether_to_dart_nml, iostat = io) - ! Record the namelist values used for the run - if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) - if (do_nml_term()) write( * , nml=aether_to_dart_nml) - else if (trim(nml) == 'dart_to_aether_nml') then - read(iunit, nml = dart_to_aether_nml, iostat = io) - ! Record the namelist values used for the run - if (do_nml_file()) write(nmlfileunit, nml=dart_to_aether_nml) - if (do_nml_term()) write( * , nml=dart_to_aether_nml) - endif - call check_namelist_read(iunit, io, trim(nml)) ! closes, too. - - - ! error-check, convert namelist input to arrays. - ! 'variables' comes from the namelist in input.nml - call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) - - !--------------------------------------------------------------- - ! TODO: Set the time step - ! Ensures model_advance_time is multiple of 'dynamics_timestep' - - ! Aether uses Julian time internally, andor a Julian calendar - ! (days from the start of the calendar), depending on the context) - call set_calendar_type( calendar ) - - !--------------------------------------------------------------- - ! 1) get grid dimensions - ! 2) allocate space for the grids - ! 3) read them from the block restart files, could be stretched ... - - call get_grid_info_from_blocks(aether_restart_dirname, nlon, nlat, nlev, nblocks_lon, & - nblocks_lat, nblocks_lev, lat_start, lat_end, lon_start) - - if( debug > 0 ) then - write(error_string_1,*) 'grid dims are ',nlon,nlat,nlev - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif - - ! Opens and closes the grid block file, but not the filter netcdf file. - call get_grid_from_blocks(aether_restart_dirname, nblocks_lon, nblocks_lat, nblocks_lev, & - nx_per_block, ny_per_block, nz_per_block, lons, lats, levs ) - - ! Convert the Aether reference date (not calendar day = 0 date) - ! to the days and seconds of the calendar set in model_mod_nml. - aether_ref_time = set_date(aether_ref_date(1), aether_ref_date(2), aether_ref_date(3), & - aether_ref_date(4), aether_ref_date(5)) - call get_time(aether_ref_time,aether_ref_nsecs,aether_ref_ndays) - - ! Get the model time from a restart file. - aether_filter_io_filename = block_file_name(variables(VT_ORIGININDX,1), 0, 0) - state_time = read_aether_time(trim(aether_restart_dirname)//'/'//trim(aether_filter_io_filename)) - - if ( debug > 0 ) then - write(error_string_1,'("grid: nlon, nlat, nlev =",3(1x,i5))') nlon, nlat, nlev - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif - -end subroutine static_init_blocks +character(len=*), intent(in) :: nml -!-------------------------------------------------------------------- +character(len=128) :: aether_filter_io_filename +character(len=vtablenamelength) :: varname +integer :: iunit, io, ivar -subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, & - nlev, nblocks_lon, nblocks_lat, nblocks_lev, lat_start, lat_end, lon_start) +character(len=*), parameter :: routine = 'static_init_blocks' - character(len=*), intent(in) :: restart_dirname - integer, intent(out) :: nlon ! Number of Longitude centers - integer, intent(out) :: nlat ! Number of Latitude centers - integer, intent(out) :: nlev ! Number of Vertical grid centers - integer, intent(out) :: nblocks_lon, nblocks_lat, nblocks_lev - real(r8), intent(out) :: lat_start, lat_end, lon_start +if (module_initialized) return ! only need to do this once - ! TODO: get the grid info from a namelist (98 variables), instead of Aether's UAM.in. - ! Then remove functions read_in_*. - ! The rest of the UAM.in contents are for running Aether. - ! Can wait until aether_to_dart push is done. - character(len=*), parameter :: filename = 'UAM.in' +! This prevents subroutines called from here from calling static_init_mod. +module_initialized = .true. - character(len=100) :: cline ! iCharLen_ == 100 - character(len=256) :: file_loc +!------------------ +! Read the namelist + +call find_namelist_in_file("input.nml", trim(nml), iunit) +if (trim(nml) == 'aether_to_dart_nml') then + read(iunit, nml = aether_to_dart_nml, iostat = io) + ! Record the namelist values used for the run + if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) + if (do_nml_term()) write( * , nml=aether_to_dart_nml) +else if (trim(nml) == 'dart_to_aether_nml') then + read(iunit, nml = dart_to_aether_nml, iostat = io) + ! Record the namelist values used for the run + if (do_nml_file()) write(nmlfileunit, nml=dart_to_aether_nml) + if (do_nml_term()) write( * , nml=dart_to_aether_nml) +endif +call check_namelist_read(iunit, io, trim(nml)) ! closes, too. - integer :: i, iunit, ios - character(len=*), parameter :: routine = 'get_grid_info_from_blocks' +! error-check, convert namelist input to arrays. +! 'variables' comes from the namelist in input.nml +call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) - ! get the ball rolling ... +!--------------------------------------------------------------- +! TODO: Set the time step +! Ensures model_advance_time is multiple of 'dynamics_timestep' - nblocks_lon = 0 - nblocks_lat = 0 - nblocks_lev = 0 - lat_start = 0.0_r8 - lat_end = 0.0_r8 - lon_start = 0.0_r8 +! Aether uses Julian time internally, andor a Julian calendar +! (days from the start of the calendar), depending on the context) +call set_calendar_type( calendar ) - write(file_loc,'(a,''/'',a)') trim(restart_dirname),trim(filename) +!--------------------------------------------------------------- +! 1) get grid dimensions +! 2) allocate space for the grids +! 3) read them from the block restart files, could be stretched ... - if (debug > 4) then - write(error_string_1,*) 'Now opening Aether UAM file: ',trim(file_loc) - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - end if +call get_grid_info_from_blocks(aether_restart_dirname, nlon, nlat, nlev, nblocks_lon, & + nblocks_lat, nblocks_lev, lat_start, lat_end, lon_start) +if( debug > 0 ) then + write(error_string_1,*) 'grid dims are ', nlon, nlat, nlev + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +endif - iunit = open_file(trim(file_loc), action='read') +! Opens and closes the grid block file, but not the filter netcdf file. +call get_grid_from_blocks(aether_restart_dirname, nblocks_lon, nblocks_lat, nblocks_lev, & + nx_per_block, ny_per_block, nz_per_block, lons, lats, levs ) - UAMREAD : do i = 1, 1000000 +! Convert the Aether reference date (not calendar day = 0 date) +! to the days and seconds of the calendar set in model_mod_nml. +aether_ref_time = set_date(aether_ref_date(1), aether_ref_date(2), aether_ref_date(3), & + aether_ref_date(4), aether_ref_date(5)) +call get_time(aether_ref_time, aether_ref_nsecs, aether_ref_ndays) - read(iunit,'(a)',iostat=ios) cLine +! Get the model time from a restart file. +aether_filter_io_filename = block_file_name(variables(VT_ORIGININDX,1), 0, 0) +state_time = read_aether_time(trim(aether_restart_dirname)//'/'//trim(aether_filter_io_filename)) - if (ios /= 0) then - ! If we get to the end of the file or hit a read error without - ! finding what we need, die. - write(error_string_1,*) 'cannot find #GRID in ',trim(file_loc) - call error_handler(E_ERR,'get_grid_info_from_blocks',error_string_1,source,revision,revdate) - endif +if ( debug > 0 ) then + write(error_string_1,'("grid: nlon, nlat, nlev =",3(1x,i5))') nlon, nlat, nlev + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +endif + +end subroutine static_init_blocks - if (cLine(1:5) .ne. "#GRID") cycle UAMREAD +!----------------------------------------------------------------------- +! Read Aether's info file (UAM.in) to get a description of the restart file blocks' grids. - nblocks_lon = read_in_int( iunit,'nblocks_lon',trim(file_loc)) - nblocks_lat = read_in_int( iunit,'nblocks_lat',trim(file_loc)) - nblocks_lev = read_in_int( iunit,'nblocks_lev',trim(file_loc)) - lat_start = read_in_real(iunit,'lat_start', trim(file_loc)) - lat_end = read_in_real(iunit,'lat_end', trim(file_loc)) - lon_start = read_in_real(iunit,'lon_start', trim(file_loc)) +subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & + nblocks_lon, nblocks_lat, nblocks_lev, & + lat_start, lat_end, lon_start) - exit UAMREAD +character(len=*), intent(in) :: restart_dirname +integer, intent(out) :: nlon ! Number of Longitude centers +integer, intent(out) :: nlat ! Number of Latitude centers +integer, intent(out) :: nlev ! Number of Vertical grid centers +integer, intent(out) :: nblocks_lon, nblocks_lat, nblocks_lev +real(r8), intent(out) :: lat_start, lat_end, lon_start - enddo UAMREAD +character(len=100) :: cline ! iCharLen_ == 100 +character(len=256) :: file_loc +integer :: i, iunit, ios - if (debug > 4) then - write(error_string_1,*) 'Successfully read Aether UAM grid file:',trim(file_loc) - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' nblocks_lon:',nblocks_lon - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' nblocks_lat:',nblocks_lat - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' nblocks_lev:',nblocks_lev - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' lat_start:',lat_start - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' lat_end:',lat_end - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' lon_start:',lon_start - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - end if +! TODO: get the grid info from a namelist (98 variables), instead of Aether's UAM.in. +! Then remove functions read_in_*. +! The rest of the UAM.in contents are for running Aether. +! Can wait until aether_to_dart push is done. +character(len=*), parameter :: filename = 'UAM.in' +character(len=*), parameter :: routine = 'get_grid_info_from_blocks' - call close_file(iunit) +! get the ball rolling ... -end subroutine get_grid_info_from_blocks +nblocks_lon = 0 +nblocks_lat = 0 +nblocks_lev = 0 +lat_start = 0.0_r8 +lat_end = 0.0_r8 +lon_start = 0.0_r8 -!-------------------------------------------------------------------- +write(file_loc,'(a,''/'',a)') trim(restart_dirname), trim(filename) -subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, & - nx_per_block, ny_per_block, nz_per_block, & - lons, lats, levs ) - - character(len=*), intent(in) :: dirname - integer, intent(in) :: nblocks_lon ! Number of Longitude blocks - integer, intent(in) :: nblocks_lat ! Number of Latitude blocks - integer, intent(in) :: nblocks_lev ! Number of Altitude blocks - integer, intent(out) :: nx_per_block ! Number of non-halo Longitude centers per block - integer, intent(out) :: ny_per_block ! Number of non-halo Latitude centers per block - integer, intent(out) :: nz_per_block ! Number of Vertical grid centers - - real(r8), allocatable , dimension( : ), intent(inout) :: lons, lats, levs - - integer :: ios, nb, offset, ncid, nboff - character(len=128) :: filename - real(r4), allocatable :: temp(:,:,:) - integer :: starts(3),ends(3), xcount, ycount, zcount - - character(len=*), parameter :: routine = 'get_grid_from_blocks' - - ! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), - ! in order to calculate the n[xyz]PerBlock dimensions. - ! grid_g0000.nc looks like a worthy candidate, but a restart could be used. - write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' - ncid = nc_open_file_readonly(filename, routine) - - ! The grid (and restart) file variables have halos, so strip them off - ! to get the number of actual data values in each dimension of the block. - nx_per_block = nc_get_dimension_size(ncid, 'x', routine) - 2*nghost - ny_per_block = nc_get_dimension_size(ncid, 'y', routine) - 2*nghost - nz_per_block = nc_get_dimension_size(ncid, 'z', routine) - - nlon = nblocks_lon * nx_per_block - nlat = nblocks_lat * ny_per_block - nlev = nblocks_lev * nz_per_block - - write(error_string_1,*) 'nlon = ', nlon - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) 'nlat = ', nlat - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) 'nlev = ', nlev - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - - ! TODO; do these need to be deallocated somewhere? - ! Probably not; this is only done once, and these arrays are needed - ! through most of the a2d and d2a programs. - allocate( lons( nlon )) - allocate( lats( nlat )) - allocate( levs( nlev )) - - if (debug > 4) then - write(error_string_1,*) 'Successfully read Aether grid file:',trim(filename) - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' nx_per_block:',nx_per_block - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' ny_per_block:',ny_per_block - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*) ' nz_per_block:',nz_per_block - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif - - ! A temp array large enough to hold any of the 3D - ! Lon,Lat or Alt arrays from a block plus ghost cells. - ! The restart files have C-indexing (fastest changing dim is the last). - allocate(temp( 1:nz_per_block, & - 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost)) - temp = MISSING_R4 - - starts(1) = 1-nghost - starts(2) = 1-nghost - starts(3) = 1 - ends(1) = nx_per_block+nghost - ends(2) = ny_per_block+nghost - ends(3) = nz_per_block - xcount = nx_per_block + 2*nghost - ycount = ny_per_block + 2*nghost - zcount = nz_per_block - if ( debug > 0 ) then - write(error_string_1,'(2(A,3i5),A,3(1X,i5))') & - 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif - - ! go across the south-most block row picking up all longitudes - do nb = 1, nblocks_lon - - ! filename is trimmed by passage to open_block_file + "len=*" there. - filename = block_file_name('grid', -1, nb-1) - ncid = open_block_file(filename, 'read') - - ! Read 3D array and extract the longitudes of the non-halo data of this block. - ! The restart files have C-indexing (fastest changing dim is the last), - ! So invert the dimension bounds. - call nc_get_variable(ncid, 'Longitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - context=routine, & - nc_count=(/zcount,ycount,xcount/)) - - offset = (nx_per_block * (nb - 1)) - lons(offset+1:offset+nx_per_block) = temp(1,1,1:nx_per_block) - - call nc_close_file(ncid) - enddo +if (debug > 4) then +write(error_string_1,*) 'Now opening Aether UAM file: ', trim(file_loc) +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +end if - ! go up west-most block row picking up all latitudes - do nb = 1, nblocks_lat - ! Aether's block name counter start with 0, but the lat values can come from - ! any lon=const column of blocks. - nboff = ((nb - 1) * nblocks_lon) - filename = block_file_name('grid', -1, nboff) - ncid = open_block_file(filename, 'read') - - call nc_get_variable(ncid, 'Latitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - context=routine, nc_count=(/zcount,ycount,xcount/)) - - - offset = (ny_per_block * (nb - 1)) - lats(offset+1:offset+ny_per_block) = temp(1,1:ny_per_block,1) - - call nc_close_file(ncid) - enddo +iunit = open_file(trim(file_loc), action='read') +UAMREAD : do i = 1, 1000000 - ! this code assumes UseTopography is false - that all columns share - ! the same altitude array, so we can read it from the first block. - ! if this is not the case, this code has to change. +read(iunit,'(a)',iostat=ios) cLine - filename = block_file_name('grid', -1, 0) - ncid = open_block_file(filename, 'read') +if (ios /= 0) then +! If we get to the end of the file or hit a read error without +! finding what we need, die. +write(error_string_1,*) 'cannot find #GRID in ', trim(file_loc) +call error_handler(E_ERR,'get_grid_info_from_blocks', error_string_1, source, revision, revdate) +endif - temp = MISSING_R8 - call nc_get_variable(ncid, 'Altitude', & - temp(starts(3):ends(3),starts(2):ends(2),starts(1):ends(1)), & - context=routine, nc_count=(/zcount,ycount,xcount/)) +if (cLine(1:5) .ne. "#GRID") cycle UAMREAD + +nblocks_lon = read_in_int( iunit,'nblocks_lon', trim(file_loc)) +nblocks_lat = read_in_int( iunit,'nblocks_lat', trim(file_loc)) +nblocks_lev = read_in_int( iunit,'nblocks_lev', trim(file_loc)) +lat_start = read_in_real(iunit,'lat_start', trim(file_loc)) +lat_end = read_in_real(iunit,'lat_end', trim(file_loc)) +lon_start = read_in_real(iunit,'lon_start', trim(file_loc)) + +exit UAMREAD + +enddo UAMREAD + +if (debug > 4) then +write(error_string_1,*) 'Successfully read Aether UAM grid file:', trim(file_loc) +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +write(error_string_1,*) ' nblocks_lon:', nblocks_lon +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +write(error_string_1,*) ' nblocks_lat:', nblocks_lat +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +write(error_string_1,*) ' nblocks_lev:', nblocks_lev +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +write(error_string_1,*) ' lat_start:', lat_start +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +write(error_string_1,*) ' lat_end:', lat_end +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +write(error_string_1,*) ' lon_start:', lon_start +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +end if + +call close_file(iunit) - levs(1:nz_per_block) = temp(1:nz_per_block,1,1) +end subroutine get_grid_info_from_blocks - call nc_close_file(ncid) +!----------------------------------------------------------------------- +! Read block grid values (2D arrays) from a grid NetCDF file. +! Allocate and fill the full-domain 1-D dimension arrays (lon, lat, levs) - deallocate(temp) +subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, & + nx_per_block, ny_per_block, nz_per_block, & + lons, lats, levs ) + +character(len=*), intent(in) :: dirname +integer, intent(in) :: nblocks_lon ! Number of Longitude blocks +integer, intent(in) :: nblocks_lat ! Number of Latitude blocks +integer, intent(in) :: nblocks_lev ! Number of Altitude blocks +integer, intent(out) :: nx_per_block ! Number of non-halo Longitude centers per block +integer, intent(out) :: ny_per_block ! Number of non-halo Latitude centers per block +integer, intent(out) :: nz_per_block ! Number of Vertical grid centers +real(r8), allocatable, dimension, intent(inout) :: lons(:), lats(:), levs(:) + +integer :: ios, nb, offset, ncid, nboff +integer :: starts(3), ends(3), xcount, ycount, zcount +character(len=128) :: filename +real(r4), allocatable :: temp(:,:,:) + +character(len=*), parameter :: routine = 'get_grid_from_blocks' + +! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), +! in order to calculate the n[xyz]PerBlock dimensions. +! grid_g0000.nc looks like a worthy candidate, but a restart could be used. +write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' +ncid = nc_open_file_readonly(filename, routine) + +! The grid (and restart) file variables have halos, so strip them off +! to get the number of actual data values in each dimension of the block. +nx_per_block = nc_get_dimension_size(ncid, 'x', routine) - (2 * nghost) +ny_per_block = nc_get_dimension_size(ncid, 'y', routine) - (2 * nghost) +nz_per_block = nc_get_dimension_size(ncid, 'z', routine) + +nlon = nblocks_lon * nx_per_block +nlat = nblocks_lat * ny_per_block +nlev = nblocks_lev * nz_per_block + +write(error_string_1,*) 'nlon = ', nlon +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +write(error_string_1,*) 'nlat = ', nlat +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +write(error_string_1,*) 'nlev = ', nlev +call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + +! TODO; do these need to be deallocated somewhere? +! Probably not; this is only done once, and these arrays are needed +! through most of the a2d and d2a programs. +allocate( lons( nlon )) +allocate( lats( nlat )) +allocate( levs( nlev )) + +if (debug > 4) then + write(error_string_1,*) 'Successfully read Aether grid file:', trim(filename) + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + write(error_string_1,*) ' nx_per_block:', nx_per_block + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + write(error_string_1,*) ' ny_per_block:', ny_per_block + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + write(error_string_1,*) ' nz_per_block:', nz_per_block + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +endif - ! convert from radians into degrees - lons = lons * RAD2DEG - lats = lats * RAD2DEG +! A temp array large enough to hold any of the 3D +! Lon, Lat or Alt arrays from a block plus ghost cells. +! The restart files have C-indexing (fastest changing dim is the last). +allocate(temp( 1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) +temp = MISSING_R4 + +starts(1) = 1 - nghost +starts(2) = 1 - nghost +starts(3) = 1 +ends(1) = nx_per_block + nghost +ends(2) = ny_per_block + nghost +ends(3) = nz_per_block +xcount = nx_per_block + (2 * nghost) +ycount = ny_per_block + (2 * nghost) +zcount = nz_per_block +if ( debug > 0 ) then + write(error_string_1,'(2(A,3i5),A,3(1X,i5))') & + 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +endif - if (debug > 4) then - print *, routine, 'All lons ', lons - print *, routine, 'All lats ', lats - print *, routine, 'All levs ', levs - endif +! go across the south-most block row picking up all longitudes +do nb = 1, nblocks_lon - if ( debug > 1 ) then ! Check dimension limits - write(error_string_1,*)'LON range ',minval(lons),maxval(lons) - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*)'LAT range ',minval(lats),maxval(lats) - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*)'ALT range ',minval(levs),maxval(levs) - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif + ! filename is trimmed by passage to open_block_file + "len=*" there. + filename = block_file_name('grid', -1, nb-1) + ncid = open_block_file(filename, 'read') -end subroutine get_grid_from_blocks + ! Read 3D array and extract the longitudes of the non-halo data of this block. + ! The restart files have C-indexing (fastest changing dim is the last), + ! So invert the dimension bounds. + call nc_get_variable(ncid, 'Longitude', & + temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & + context=routine, & + nc_count=(/ zcount,ycount,xcount /)) -!================================================================== + offset = (nx_per_block * (nb - 1)) + lons(offset+1:offset+nx_per_block) = temp(1,1,1:nx_per_block) -function read_aether_time(filename) -type(time_type) :: read_aether_time -character(len=*), intent(in) :: filename + call nc_close_file(ncid) +enddo -integer :: ncid -integer :: tsimulation ! the time read from a restart file; seconds from aether_ref_date. -integer :: ndays,nsecs +! go up west-most block row picking up all latitudes +do nb = 1, nblocks_lat -character(len=*), parameter :: routine = 'read_aether_time' + ! Aether's block name counter start with 0, but the lat values can come from + ! any lon=const column of blocks. + nboff = ((nb - 1) * nblocks_lon) + filename = block_file_name('grid', -1, nboff) + ncid = open_block_file(filename, 'read') + + call nc_get_variable(ncid, 'Latitude', & + temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & + context=routine, nc_count=(/zcount,ycount,xcount/)) + + + offset = (ny_per_block * (nb - 1)) + lats(offset+1:offset+ny_per_block) = temp(1,1:ny_per_block,1) + + call nc_close_file(ncid) +enddo + + +! this code assumes UseTopography is false - that all columns share +! the same altitude array, so we can read it from the first block. +! if this is not the case, this code has to change. + +filename = block_file_name('grid', -1, 0) +ncid = open_block_file(filename, 'read') + +temp = MISSING_R8 +call nc_get_variable(ncid, 'Altitude', & + temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & + context=routine, nc_count=(/zcount,ycount,xcount/)) + +levs(1:nz_per_block) = temp(1:nz_per_block,1,1) + +call nc_close_file(ncid) + +deallocate(temp) + +! convert from radians into degrees +lons = lons * RAD2DEG +lats = lats * RAD2DEG + +if (debug > 4) then + print *, routine, 'All lons ', lons + print *, routine, 'All lats ', lats + print *, routine, 'All levs ', levs +endif + +if ( debug > 1 ) then ! Check dimension limits + write(error_string_1,*)'LON range ', minval(lons), maxval(lons) + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + write(error_string_1,*)'LAT range ', minval(lats), maxval(lats) + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + write(error_string_1,*)'ALT range ', minval(levs), maxval(levs) + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +endif + +end subroutine get_grid_from_blocks + +!----------------------------------------------------------------------- +! Read the Aether restart file time and convert to a DART time. + +function read_aether_time(filename) +type(time_type) :: read_aether_time +character(len=*), intent(in) :: filename + +integer :: ncid +integer :: tsimulation ! the time read from a restart file; seconds from aether_ref_date. +integer :: ndays, nsecs + +character(len=*), parameter :: routine = 'read_aether_time' tsimulation = MISSING_I @@ -1381,25 +1398,25 @@ function read_aether_time(filename) ! Calculate the DART time of the file time. ! TODO: review calculation of ndays in read_aether_time -ndays = tsimulation/86400 -nsecs = tsimulation - ndays*86400 +ndays = tsimulation / 86400 +nsecs = tsimulation - (ndays * 86400) ! The ref day is not finished, but don't need to subtract 1 because ! that was accounted for in the integer calculation of ndays. ndays = aether_ref_ndays + ndays -read_aether_time = set_time(nsecs,ndays) +read_aether_time = set_time(nsecs, ndays) if (do_output()) & - call print_time(read_aether_time,routine//': time in restart file '//filename) + call print_time(read_aether_time, routine//': time in restart file '//filename) if (do_output()) & - call print_date(read_aether_time,routine//': date in restart file '//filename) + call print_date(read_aether_time, routine//': date in restart file '//filename) if (debug > 8) then - write(error_string_1,*)'tsimulation ',tsimulation - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*)'ndays ',ndays - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,*)'nsecs ',nsecs - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + write(error_string_1,*)'tsimulation ', tsimulation + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + write(error_string_1,*)'ndays ', ndays + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + write(error_string_1,*)'nsecs ', nsecs + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) call print_date(aether_ref_time, routine//':model base date') call print_time(aether_ref_time, routine//':model base time') @@ -1407,788 +1424,807 @@ function read_aether_time(filename) end function read_aether_time -!================================================================== +!----------------------------------------------------------------------- +! Convert Aether's non-CF-compliant names into CF-compliant names for filter. +! For the ions, it moves the name of the ion from the end of the variable names +! to the beginning. function aether_name_to_dart(varname) - character(len=vtablenamelength), intent(in) :: varname - - character(len=vtablenamelength) :: aether_name_to_dart, aether - character(len=64) :: parts(8), var_root - integer :: char_num, first, i_parts, aether_len, end_str - - aether = trim(varname) - aether_len = len_trim(varname) - parts = '' - - ! Look for the last ' '. The characters after that are the species. - ! If there's no ' ', the whole string is the species. - char_num = 0 - char_num = scan(trim(aether),' ',back=.true.) - var_root = aether(char_num+1:aether_len) - ! purge_chars removes unwanted [()\] - parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) - ! TODO: keep aether_name_to_dart diagnostic? - ! print*,'var_root, parts(1) = ',var_root, parts(1) - end_str = char_num - - ! Tranform remaining pieces of varname into DART versions. - char_num = MISSING_I - first = 1 - i_parts = 2 - do - ! This returns the position of the first blank *within the substring* passed in. - char_num = scan(aether(first:end_str),' ',back=.false.) - if (char_num > 0 .and. first < aether_len) then - parts(i_parts) = purge_chars(aether(first:first+char_num-1), '.)(\', plus_minus=.true.) - - first = first + char_num - i_parts = i_parts + 1 - else - exit - endif - enddo - - ! Construct the DART field name from the parts - aether_name_to_dart = trim(parts(1)) - i_parts = 2 - do +character(len=vtablenamelength), intent(in) :: varname + +character(len=vtablenamelength) :: aether_name_to_dart, aether +character(len=64) :: parts(8), var_root +integer :: char_num, first, i_parts, aether_len, end_str + +aether = trim(varname) +aether_len = len_trim(varname) +parts = '' + +! Look for the last ' '. The characters after that are the species. +! If there's no ' ', the whole string is the species. +char_num = 0 +char_num = scan(trim(aether),' ', back=.true.) +var_root = aether(char_num+1:aether_len) +! purge_chars removes unwanted [()\] +parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) +! TODO: keep aether_name_to_dart diagnostic? +! print*,'var_root, parts(1) = ', var_root, parts(1) +end_str = char_num + +! Tranform remaining pieces of varname into DART versions. +char_num = MISSING_I +first = 1 +i_parts = 2 +Parts : do + ! This returns the position of the first blank *within the substring* passed in. + char_num = scan(aether(first:end_str),' ', back=.false.) + if (char_num > 0 .and. first < aether_len) then + parts(i_parts) = purge_chars(aether(first:first+char_num-1), '.)(\', plus_minus=.true.) + + first = first + char_num + i_parts = i_parts + 1 + else + exit Parts + endif +enddo Parts + +! Construct the DART field name from the parts +aether_name_to_dart = trim(parts(1)) +i_parts = 2 +Build : do if (trim(parts(i_parts)) /= '') then aether_name_to_dart = trim(aether_name_to_dart)//'_'//trim(parts(i_parts)) i_parts = i_parts + 1 else - exit + exit Build endif - enddo +enddo Build end function aether_name_to_dart -!----------------------------------------------------------------- +!----------------------------------------------------------------------- ! Replace undesirable characters with better. function purge_chars(ugly_string, chars, plus_minus) - character (len=*), intent(in) :: ugly_string, chars - logical, intent(in) :: plus_minus - character (len=64) :: purge_chars - character (len=256) :: temp_str - - integer :: char_num, end_str, pm_num - - ! Trim is not needed here - temp_str = ugly_string - end_str = len_trim(temp_str) - char_num = MISSING_I - do - ! Returns 0 if chars are not found - char_num = scan(temp_str,chars) - ! Need to change it to a char that won't be found by scan in the next iteration, - ! and can be easily removed. - if (char_num > 0) then - ! Squeeze out the character - temp_str(char_num:end_str-1) = temp_str(char_num+1:end_str) - temp_str(end_str:end_str) = '' - ! temp_str(char_num:char_num) = ' ' - else - exit - endif - enddo - - ! Replace + and - with pos and neg. Assume there's only 1. - temp_str = trim(adjustl(temp_str)) - end_str = len_trim(temp_str) - pm_num = scan(trim(temp_str),'+-',back=.false.) - if (pm_num == 0 .or. .not. plus_minus) then - purge_chars = trim(temp_str) +character (len=*), intent(in) :: ugly_string, chars +logical, intent(in) :: plus_minus +character (len=64) :: purge_chars + +character (len=256) :: temp_str + +integer :: char_num, end_str, pm_num + +! Trim is not needed here +temp_str = ugly_string +end_str = len_trim(temp_str) +char_num = MISSING_I +Squeeze : do + ! Returns 0 if chars are not found + char_num = scan(temp_str, chars) + ! Need to change it to a char that won't be found by scan in the next iteration, + ! and can be easily removed. + if (char_num > 0) then + ! Squeeze out the character + temp_str(char_num:end_str-1) = temp_str(char_num+1:end_str) + temp_str(end_str:end_str) = '' +! temp_str(char_num:char_num) = ' ' else - if (temp_str(pm_num:pm_num) == '+') then - purge_chars = temp_str(1:pm_num-1)//'pos' - else if (temp_str(pm_num:pm_num) == '-') then - purge_chars = temp_str(1:pm_num-1)//'neg' - endif - if (pm_num+1 <= end_str) & - purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) + exit Squeeze + endif +enddo Squeeze + +! Replace + and - with pos and neg. Assume there's only 1. +temp_str = trim(adjustl(temp_str)) +end_str = len_trim(temp_str) +pm_num = scan(trim(temp_str),'+-', back=.false.) +if (pm_num == 0 .or. .not. plus_minus) then + purge_chars = trim(temp_str) +else + if (temp_str(pm_num:pm_num) == '+') then + purge_chars = temp_str(1:pm_num-1)//'pos' + else if (temp_str(pm_num:pm_num) == '-') then + purge_chars = temp_str(1:pm_num-1)//'neg' endif + if (pm_num + 1 <= end_str) & + purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) +endif end function purge_chars -!--------------------------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Open an Aether restart block file (neutral, ion, ...?) + +function open_block_file(filename, rw) -function open_block_file(filename,rw) +! filename is trimmed by this definition +character(len=*), intent(in) :: filename +character(len=*), intent(in) :: rw ! 'read' or 'readwrite' +integer :: open_block_file - ! filename is trimmed by this definition - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: rw ! 'read' or 'readwrite' - integer :: open_block_file - - character(len=*), parameter :: routine = 'open_block_file' - - if ( .not. file_exist(filename) ) then - write(error_string_1,*) 'cannot open file ', filename,' for ',rw - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) - endif - - if (debug > 0) then - write(error_string_1,*) 'Opening file ', trim(filename), ' for ', rw - call error_handler(E_MSG,'open_block_file',error_string_1,source,revision,revdate) - end if - - - if (rw == 'read') then - open_block_file = nc_open_file_readonly(filename, routine) - else if (rw == 'readwrite') then - open_block_file = nc_open_file_readwrite(filename, routine) - else - error_string_1 = ': must be called with rw={read,readwrite}, not '//rw - call error_handler(E_ERR,'open_block_file',error_string_1,source,revision,revdate) - endif - - - if (debug > 80) then - write(error_string_1,*) 'Returned file descriptor is ', open_block_file - call error_handler(E_MSG,'open_block_file',error_string_1,source,revision,revdate) - end if +character(len=*), parameter :: routine = 'open_block_file' + +if ( .not. file_exist(filename) ) then + write(error_string_1,*) 'cannot open file ', filename,' for ', rw + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +endif + +if (debug > 0) then + write(error_string_1,*) 'Opening file ', trim(filename), ' for ', rw + call error_handler(E_MSG,'open_block_file', error_string_1, source, revision, revdate) +end if + + +if (rw == 'read') then + open_block_file = nc_open_file_readonly(filename, routine) +else if (rw == 'readwrite') then + open_block_file = nc_open_file_readwrite(filename, routine) +else + error_string_1 = ': must be called with rw={read,readwrite}, not '//rw + call error_handler(E_ERR,'open_block_file', error_string_1, source, revision, revdate) +endif + + +if (debug > 80) then + write(error_string_1,*) 'Returned file descriptor is ', open_block_file + call error_handler(E_MSG,'open_block_file', error_string_1, source, revision, revdate) +end if end function open_block_file -!================================================================= -! open all restart files and transfer the requested data item -! to the filter input file. +!----------------------------------------------------------------------- +! Open all restart files (blocks x {neutrals,ions}) for 1 member +! and transfer the requested variable contents to the filter input file. +! This is called with 'define' = +! .true. define variables in the file or +! .false. transfer the data from restart files to a filter_inpu.nc file. subroutine restarts_to_filter(dirname, ncid_output, member, define) - character(len=*), intent(in) :: dirname - integer, intent(in) :: ncid_output, member - logical, intent(in) :: define - - integer :: ibLoop, jbLoop - integer :: ib, jb, nb, iunit - - character(len=256) :: filter_io_filename - - - if (define) then - ! if define, run one block. - ! the block_to_filter_io call defines the variables in the whole domain netCDF file. - ibLoop = 1 - jbLoop = 1 - ! nc_write_model_atts puts it in define, and takes it out. - call nc_begin_define_mode(ncid_output) - else - ! if not define, and run all blocks. - ! the block_to_filter_io call adds the (ib,jb) block to a netCDF variable - ! in order to make a file containing the data for all the blocks. - ibLoop = nblocks_lon - jbLoop = nblocks_lat - end if - - do jb = 1, jbLoop - do ib = 1, ibLoop - - call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) - - enddo - enddo - - if (define) then - call nc_end_define_mode(ncid_output) - endif +character(len=*), intent(in) :: dirname +integer, intent(in) :: ncid_output, member +logical, intent(in) :: define + +integer :: ibLoop, jbLoop +integer :: ib, jb, nb, iunit + +character(len=256) :: filter_io_filename + + +if (define) then + ! if define, run one block. + ! the block_to_filter_io call defines the variables in the whole domain netCDF file. + ibLoop = 1 + jbLoop = 1 + ! nc_write_model_atts puts it in define, and takes it out. + call nc_begin_define_mode(ncid_output) +else + ! if not define, and run all blocks. + ! the block_to_filter_io call adds the (ib,jb) block to a netCDF variable + ! in order to make a file containing the data for all the blocks. + ibLoop = nblocks_lon + jbLoop = nblocks_lat +end if + +do jb = 1, jbLoop + do ib = 1, ibLoop + + call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) + + enddo +enddo + +if (define) then + call nc_end_define_mode(ncid_output) +endif end subroutine restarts_to_filter -!========================================================================= +!----------------------------------------------------------------------- +! Read in a real number from the UAM.in file. +! TODO: the file name should not be filter_io_filename. -function read_in_real(iunit,varname,filter_io_filename) +function read_in_real(iunit, varname, filter_io_filename) - integer, intent(in) :: iunit - character(len=*), intent(in) :: varname,filter_io_filename - real(r8) :: read_in_real - - character(len=100) :: cLine - integer :: i, ios - - ! Read a line - read(iunit,'(a)',iostat=ios) cLine - if (ios /= 0) then - write(error_string_1,*) 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'get_grid_dims',error_string_1,source,revision,revdate) - endif - - ! Remove anything after a space or TAB - i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' - i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' - - ! Now that we have a line with nothing else ... parse it - read(cLine,*,iostat=ios)read_in_real - - if(ios /= 0) then - write(error_string_1,*)'unable to read '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'read_in_real',error_string_1,source,revision,revdate) - endif +integer, intent(in) :: iunit +character(len=*), intent(in) :: varname, filter_io_filename +real(r8) :: read_in_real + +character(len=100) :: cLine +integer :: i, ios + +! Read a line +read(iunit,'(a)',iostat=ios) cLine +if (ios /= 0) then + write(error_string_1,*) 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR,'get_grid_dims', error_string_1, source, revision, revdate) +endif + +! Remove anything after a space or TAB +i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' +i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' + +! Now that we have a line with nothing else ... parse it +read(cLine,*,iostat=ios) read_in_real + +if(ios /= 0) then + write(error_string_1,'(4A)')'unable to read '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR,'read_in_real', error_string_1, source, revision, revdate) +endif end function read_in_real -!-------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Read in an integer from the UAM.in file. +! TODO: the file name should not be filter_io_filename. -function read_in_int(iunit,varname,filter_io_filename) +function read_in_int(iunit, varname, filter_io_filename) - integer, intent(in) :: iunit - character(len=*), intent(in) :: varname,filter_io_filename - integer :: read_in_int - - character(len=100) :: cLine - integer :: i, ios - - ! Read a line - read(iunit,'(a)',iostat=ios) cLine - if (ios /= 0) then - write(error_string_1,*) 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'get_grid_dims',error_string_1,source,revision,revdate) - endif - - ! Remove anything after a space or TAB - i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' - i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' - - read(cLine,*,iostat=ios)read_in_int - - if(ios /= 0) then - write(error_string_1,*)'unable to read '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'read_in_int',error_string_1,source,revision,revdate,& - text2=cLine) - endif +integer, intent(in) :: iunit +character(len=*), intent(in) :: varname, filter_io_filename +integer :: read_in_int + +character(len=100) :: cLine +integer :: i, ios + +! Read a line +read(iunit,'(a)',iostat=ios) cLine +if (ios /= 0) then + write(error_string_1,*) 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR,'get_grid_dims', error_string_1, source, revision, revdate) +endif + +! Remove anything after a space or TAB +i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' +i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' + +read(cLine,*,iostat=ios) read_in_int + +if(ios /= 0) then + write(error_string_1,'(4A)')'unable to read '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR,'read_in_int', error_string_1, source, revision, revdate, & + text2=cLine) +endif end function read_in_int -!-------------------------------------------------------------------- -!> Open all restart files for a block and read in the requested data items. -!> The write_filter_io calls will write the data to the filter_input.nc. -!> -!> This is a two-pass method: first run through to define the NC variables -!> in the filter_input.nc (define = .true.), -!> then run again to write the data to the NC file(define = .false.) +!----------------------------------------------------------------------- +! Open all restart files (neutrals,ions) for a block and read in the requested data items. +! The write_filter_io calls will write the data to the filter_input.nc. subroutine write_filter_io(data3d, varname, block, ncid) - real(r4), intent(in) :: data3d(1:nz_per_block, & - 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost) - - character(len=vtablenamelength), intent(in) :: varname - integer, intent(in) :: block(2) - integer, intent(in) :: ncid - - integer :: ib, jb - integer :: starts(3) - character(len=*), parameter :: routine = 'write_filter_io' - - - ! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) - - ib = block(1) - jb = block(2) - - ! to compute the start, consider (ib-1)*nx_per_block+1 - starts(1) = 1 - starts(2) = (jb-1)*ny_per_block+1 - starts(3) = (ib-1)*nx_per_block+1 - ! TODO: convert to error_msg - ! print*,routine,'; starts = ',starts - ! print*,routine,'; counts = ',nz_per_block,ny_per_block,nx_per_block,1 - - call nc_put_variable(ncid, varname, & - data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & - context=routine, nc_start=starts, & - nc_count=(/nz_per_block,ny_per_block,nx_per_block/)) - ! TODO: convert to error_msg - ! print*,routine,': filled varname = ', varname +real(r4), intent(in) :: data3d(1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost) + +character(len=vtablenamelength), intent(in) :: varname +integer, intent(in) :: block(2) +integer, intent(in) :: ncid + +integer :: ib, jb +integer :: starts(3) + +character(len=*), parameter :: routine = 'write_filter_io' + +! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) + +ib = block(1) +jb = block(2) + +! to compute the start, consider (ib-1)*nx_per_block+1 +starts(1) = 1 +starts(2) = (jb-1) * ny_per_block + 1 +starts(3) = (ib-1) * nx_per_block + 1 +! TODO: convert to error_msg +! print*, routine,'; starts = ', starts +! print*, routine,'; counts = ', nz_per_block, ny_per_block, nx_per_block,1 + +call nc_put_variable(ncid, varname, & + data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & + context=routine, nc_start=starts, & + nc_count=(/nz_per_block,ny_per_block,nx_per_block/)) +! TODO: convert to error_msg +! print*, routine,': filled varname = ', varname end subroutine write_filter_io -!-------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Transfer variable data from a block restart file to the filter_input.nc file. +! It's called with 2 modes: +! define = .true. define the NC variables in the filter_input.nc +! define = .false. write the data from a block to the NC file using write_filter_io. subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) - integer, intent(in) :: ncid_output - character(len=*), intent(in) :: dirname - integer, intent(in) :: ib, jb - integer, intent(in) :: member - logical, intent(in) :: define - - real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) - real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) - real(r4) :: temp0d !Alex: single parameter has "zero dimensions" - integer :: i, j, maxsize, ivar, nb, ncid_input - integer :: block(2) = 0 - - logical :: no_idensity - - character(len=*), parameter :: routine = 'block_to_filter_io' - character(len=32) :: att_val - character(len=128) :: file_root - character(len=256) :: filename - character(len=vtablenamelength) :: varname, dart_varname - - block(1) = ib - block(2) = jb - ! The block number, as counted in Aether. - ! Lower left is 0, increase to the East, then 1 row farther north, West to East. - nb = (jb-1) * nblocks_lon + ib - 1 - - ! a temp array large enough to hold any of the - ! Lon,Lat or Alt array from a block plus ghost cells - allocate(temp1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) - - ! treat alt specially since we want to derive TEC here - ! TODO: See density_ion_e too. - allocate( alt1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) - - ! temp array large enough to hold any 2D field - allocate(temp2d(1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost)) - - ! TODO: We need all altitudes, but there might be vertical blocks in the future. - ! But there would be no vertical halos. - ! Make nzcount adapt to whether there are blocks. - ! And temp needs to have C-ordering, which is what the restart files have. - ! temp array large enough to hold 1 species, temperature, etc - allocate(temp3d(1:nz_per_block, & - 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost)) - - ! TODO: Waiting for e- guidance from Aaron. - ! save density_ion_e to compute TEC - allocate(density_ion_e(1:nz_per_block, & - 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost)) - - ! TODO: Aether gives a unique name to each (of 6) velocity components. - ! Do we want to use a temp4d array to handle them? - ! They are independent variables in the block files (and state). - ! ! temp array large enough to hold velocity vect, etc - ! maxsize = max(3, nSpecies) - ! allocate(temp4d(1-nghost:nx_per_block+nghost, & - ! 1-nghost:ny_per_block+nghost, & - ! 1-nghost:nz_per_block+nghost, maxsize)) - - - ! TODO; Does Aether need a replacement for these Density fields? Yes. - ! But they are probably read by the loops below. - ! Don't need to fetch index because Aether has NetCDF restarts, - ! so just loop over the field names to read. - ! - ! ! assume we could not find the electron density for VTEC calculations - ! no_idensity = .true. - ! - ! if (inum > 0) then - ! ! one or more items in the state vector need to replace the - ! ! data in the output file. loop over the index list in order. - ! j = 1 - ! ! TODO: electron density is not in the restart files, but it's needed for TEC - ! In Aether they will be from an ions file, but now only from an output file (2023-10-30). - ! Can that be handled like the neutrals and ions files, using variables(VT_ORIGININDX,:) - ! to build an output file name? Are outputs in block form? - ! ! save the electron density for TEC computation - ! density_ion_e(:,:,:) = temp3d(:,:,:) - - ! Handle the 2 restart file types (ions and neutrals). - ! Each field has a file type associated with it: variables(VT_ORIGININDX,f_index) - ! TODO: for now require that all neutrals are listed in variables before the ions. - - file_root = variables(VT_ORIGININDX,1) - filename = block_file_name(file_root, member, nb) - ncid_input = open_block_file(filename, 'read') - - ! TODO: prints > ERR_MSG? - if (debug >= 100 .and. do_output()) print*,'block_to_filter_io: nvar_neutral = ',nvar_neutral - do ivar = 1, nvar_neutral - ! The nf90 functions cannot read the variable names with the '\'s in them. - varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - if (debug >= 100 .and. do_output()) print*,routine,'varname = ',varname - ! Translate the Aether field name into a DART field name. - dart_varname = aether_name_to_dart(varname) - - ! TODO: Given the subroutine name, perhaps these definition sections should be - ! one call higher up, with the same loop around it. - if (define) then - ! Define the variable in the filter_input.nc file (the output from this program). - ! The calling routine entered define mode. - - if (debug > 10 .and. do_output()) then - write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',dart_varname - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - end if - - call nc_define_real_variable(ncid_output, dart_varname, & - (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) - call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) - call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units',att_val, routine) - - else if (file_root == 'neutrals') then - ! Read 3D array and extract the non-halo data of this block. - ! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. - call nc_get_variable(ncid_input, varname, temp3d, context=routine) - if (debug >= 100 .and. do_output()) then - ! TODO convert to error_handler? Or diagnostics are no longer useful? - print*,'block_to_filter_io: temp3d = ',temp3d(1,1,1),temp3d(15,15,15),varname - print*,'block_to_filter_io: define = ',define - endif - call write_filter_io(temp3d, dart_varname, block, ncid_output) - else - write(error_string_1,*) 'Trying to read neutrals, but variables(',VT_ORIGININDX,ivar , & - ') /= "neutrals"' - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) - endif - - enddo - call nc_close_file(ncid_input) - - file_root = variables(VT_ORIGININDX,nvar_neutral+1) - filename = block_file_name(file_root, member, nb) - ncid_input = open_block_file(filename, 'read') - - do ivar = nvar_neutral +1,nvar_neutral + nvar_ion - ! Purging \ from aether name. - varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - dart_varname = aether_name_to_dart(varname) - - if (define) then - - if (debug > 10 .and. do_output()) then - write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':',dart_varname - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - end if - - call nc_define_real_variable(ncid_output, dart_varname, & - (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) - call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) - call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units',att_val, routine) - print*,routine,': defined ivar, dart_varname, att = ', ivar, dart_varname,att_val +integer, intent(in) :: ncid_output +character(len=*), intent(in) :: dirname +integer, intent(in) :: ib, jb +integer, intent(in) :: member +logical, intent(in) :: define + +real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) +real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) +real(r4) :: temp0d +integer :: i, j, maxsize, ivar, nb, ncid_input +integer :: block(2) = 0 +logical :: no_idensity +character(len=32) :: att_val +character(len=128) :: file_root +character(len=256) :: filename +character(len=vtablenamelength) :: varname, dart_varname + +character(len=*), parameter :: routine = 'block_to_filter_io' + +block(1) = ib +block(2) = jb +! The block number, as counted in Aether. +! Lower left is 0, increase to the East, then 1 row farther north, West to East. +nb = (jb - 1) * nblocks_lon + ib - 1 + +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +allocate(temp1d(1-nghost:max(nx_per_block, ny_per_block, nz_per_block) + nghost)) + +! treat alt specially since we want to derive TEC here +! TODO: See density_ion_e too. +allocate( alt1d(1-nghost:max(nx_per_block, ny_per_block, nz_per_block) + nghost)) + +! temp array large enough to hold any 2D field +allocate(temp2d(1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) + +! TODO: We need all altitudes, but there might be vertical blocks in the future. +! But there would be no vertical halos. +! Make nzcount adapt to whether there are blocks. +! And temp needs to have C-ordering, which is what the restart files have. +! temp array large enough to hold 1 species, temperature, etc +allocate(temp3d(1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) + +! TODO: Waiting for e- guidance from Aaron. +! save density_ion_e to compute TEC +allocate(density_ion_e(1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) + +! TODO: Aether gives a unique name to each (of 6) velocity components. +! Do we want to use a temp4d array to handle them? +! They are independent variables in the block files (and state). +! ! temp array large enough to hold velocity vect, etc +! maxsize = max(3, nSpecies) +! allocate(temp4d(1-nghost:nx_per_block+nghost, & +! 1-nghost:ny_per_block+nghost, & +! 1-nghost:nz_per_block+nghost, maxsize)) + + +! TODO; Does Aether need a replacement for these Density fields? Yes. +! But they are probably read by the loops below. +! Don't need to fetch index because Aether has NetCDF restarts, +! so just loop over the field names to read. +! +! ! assume we could not find the electron density for VTEC calculations +! no_idensity = .true. +! +! if (inum > 0) then +! ! one or more items in the state vector need to replace the +! ! data in the output file. loop over the index list in order. +! j = 1 +! ! TODO: electron density is not in the restart files, but it's needed for TEC +! In Aether they will be from an ions file, but now only from an output file (2023-10-30). +! Can that be handled like the neutrals and ions files, using variables(VT_ORIGININDX,:) +! to build an output file name? Are outputs in block form? +! ! save the electron density for TEC computation +! density_ion_e(:,:,:) = temp3d(:,:,:) + +! Handle the 2 restart file types (ions and neutrals). +! Each field has a file type associated with it: variables(VT_ORIGININDX,f_index) +! TODO: for now require that all neutrals are listed in variables before the ions. + +file_root = variables(VT_ORIGININDX,1) +filename = block_file_name(file_root, member, nb) +ncid_input = open_block_file(filename, 'read') + +! TODO: prints > ERR_MSG? +if (debug >= 100 .and. do_output()) print*,'block_to_filter_io: nvar_neutral = ', nvar_neutral +do ivar = 1, nvar_neutral + ! The nf90 functions cannot read the variable names with the '\'s in them. + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + if (debug >= 100 .and. do_output()) print*, routine,'varname = ', varname + ! Translate the Aether field name into a DART field name. + dart_varname = aether_name_to_dart(varname) + + ! TODO: Given the subroutine name, perhaps these definition sections should be + ! one call higher up, with the same loop around it. + if (define) then + ! Define the variable in the filter_input.nc file (the output from this program). + ! The calling routine entered define mode. + + if (debug > 10 .and. do_output()) then + write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':', dart_varname + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + end if - else if (file_root == 'ions') then - call nc_get_variable(ncid_input, varname, temp3d, context=routine) - call write_filter_io(temp3d, dart_varname, block, ncid_output) - else - write(error_string_1,*) 'Trying to read ions, but variables(',VT_ORIGININDX,ivar , & - ') /= "ions"' - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + call nc_define_real_variable(ncid_output, dart_varname, & + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) + call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) + call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units', att_val, routine) + + else if (file_root == 'neutrals') then + ! Read 3D array and extract the non-halo data of this block. +! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. + call nc_get_variable(ncid_input, varname, temp3d, context=routine) + if (debug >= 100 .and. do_output()) then + ! TODO convert to error_handler? Or diagnostics are no longer useful? + print*,'block_to_filter_io: temp3d = ', temp3d(1,1,1), temp3d(15,15,15), varname + print*,'block_to_filter_io: define = ', define endif - - enddo + call write_filter_io(temp3d, dart_varname, block, ncid_output) + else + write(error_string_1,*) 'Trying to read neutrals, but variables(',VT_ORIGININDX,ivar , & + ') /= "neutrals"' + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + endif - ! Leave file open if fields were just added (define = .false.), - ! so that time can be added. - if (define) call nc_close_file(ncid_input) - - ! TODO: Does Aether need TEC to be calculated? Yes - ! ! add the VTEC as an extended-state variable - ! ! NOTE: This variable will *not* be written out to the Aether restart files - ! - ! if (no_idensity) then - ! write(error_string_1,*) 'Cannot compute the VTEC without the electron density' - ! call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) - ! end if - ! - ! temp2d = 0._r8 - ! ! compute the TEC integral - ! do i =1,nz_per_block-1 ! approximate the integral over the altitude as a sum of trapezoids - ! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 - ! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * & - ! ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 - ! end do - ! ! convert temp2d to TEC units - ! temp2d = temp2d/1e16_r8 - ! call write_block_to_filter2d(temp2d, ivals(1), block, ncid, define) +enddo +call nc_close_file(ncid_input) + +file_root = variables(VT_ORIGININDX,nvar_neutral+1) +filename = block_file_name(file_root, member, nb) +ncid_input = open_block_file(filename, 'read') + +do ivar = nvar_neutral +1, nvar_neutral + nvar_ion + ! Purging \ from aether name. + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + dart_varname = aether_name_to_dart(varname) + + if (define) then + + if (debug > 10 .and. do_output()) then + write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':', dart_varname + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + end if - ! TODO: Does Aether need f10_7 to be calculated or processed? Yes - ! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') - ! call get_index_from_gitm_varname('f107', inum, ivals) - ! if (inum > 0) then - ! call write_block_to_filter0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine - ! endif - ! - - deallocate(temp1d, temp2d, temp3d) - deallocate(alt1d, density_ion_e) + call nc_define_real_variable(ncid_output, dart_varname, & + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) + call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) + call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units', att_val, routine) + print*, routine,': defined ivar, dart_varname, att = ', ivar, dart_varname, att_val + + else if (file_root == 'ions') then + call nc_get_variable(ncid_input, varname, temp3d, context=routine) + call write_filter_io(temp3d, dart_varname, block, ncid_output) + else + write(error_string_1,*) 'Trying to read ions, but variables(',VT_ORIGININDX,ivar , & + ') /= "ions"' + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + endif + +enddo + +! Leave file open if fields were just added (define = .false.), +! so that time can be added. +if (define) call nc_close_file(ncid_input) + +! TODO: Does Aether need TEC to be calculated? Yes +! ! add the VTEC as an extended-state variable +! ! NOTE: This variable will *not* be written out to the Aether restart files +! +! if (no_idensity) then +! write(error_string_1,*) 'Cannot compute the VTEC without the electron density' +! call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +! end if +! +! temp2d = 0._r8 +! ! compute the TEC integral +! do i =1,nz_per_block-1 ! approximate the integral over the altitude as a sum of trapezoids +! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 +! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * & +! ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 +! end do +! ! convert temp2d to TEC units +! temp2d = temp2d/1e16_r8 +! call write_block_to_filter2d(temp2d, ivals(1), block, ncid, define) + +! TODO: Does Aether need f10_7 to be calculated or processed? Yes +! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') +! call get_index_from_gitm_varname('f107', inum, ivals) +! if (inum > 0) then +! call write_block_to_filter0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine +! endif +! + +deallocate(temp1d, temp2d, temp3d) +deallocate(alt1d, density_ion_e) end subroutine block_to_filter_io -!-------------------------------------------------------------------- +!----------------------------------------------------------------------- +! Extract (updated) variables from a filter_output.nc file +! and write to existing block restart files. subroutine filter_to_restarts(ncid, member) - integer, intent(in) :: member, ncid - - real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) - character(len=256) :: file_root - integer :: ivar - - character(len=vtablenamelength):: varname, dart_varname - character(len=*), parameter :: routine = 'filter_to_restarts' - - ! Space for full domain field (read from filter_output.nc) - ! and halo around the full domain - allocate(fulldom3d(1:nlev, & - 1-nghost:nlat+nghost, & - 1-nghost:nlon+nghost)) - - ! get the dirname, construct the filenames inside open_block_file - - ! >>> TODO: Not all fields have halos suitable for calculating gradients. - ! These do (2023-11-8): neutrals; temperature, O, O2, N2, and the horizontal winds. - ! ions; none. - ! The current model_mod will fill all neutral halos anyway, - ! since that's simpler and won't break the model. - ! TODO: add an attribute to the variables (?) to denote whether a field - ! should have its halo filled. - do ivar = 1, nvar_neutral - varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - if (debug >= 0 .and. do_output()) then - write(error_string_1,'("varname = ",A)') trim(varname) - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif - dart_varname = aether_name_to_dart(varname) - - file_root = trim(variables(VT_ORIGININDX,ivar)) - if (file_root == 'neutrals') then - ! This parameter is available through the `use netcdf` command. - fulldom3d = NF90_FILL_REAL - - call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & - nc_count=(/nlev,nlat,nlon,1/),context=routine) - ! TODO: ncount not needed? Reading the whole field. - - ! Copy updated field values to full domain halo. - ! Block domains+halos will be easily read from this. - call add_halo_fulldom3d(fulldom3d) - - call filter_io_to_blocks(fulldom3d, varname, file_root, member) - else - ! TODO: error; varname is inconsistent with VT_ORIGININDX - endif - - enddo - - do ivar = nvar_neutral+1, nvar_neutral + nvar_ion - varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - dart_varname = aether_name_to_dart(varname) - - file_root = trim(variables(VT_ORIGININDX,ivar)) - if (debug >= 0 .and. do_output()) then - write(error_string_1,'("varname, dart_varname, file_root = ",3(2x,A))') & - trim(varname), trim(dart_varname), file_root - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif - - if (file_root == 'ions') then - fulldom3d = NF90_FILL_REAL - call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & - nc_count=(/nlev,nlat,nlon,1/),context=routine) - !? ncount not needed? Reading the whole field. - - ! 2023-11: ions do not have real or used data in their halos. - ! Make this clear by leaving the halos filled with MISSING_R4 - ! TODO: Will this be translated into NetCDF missing_value? - ! call add_halo_fulldom3d(fulldom3d) - - call filter_io_to_blocks(fulldom3d, varname, file_root, member) - - else - ! TODO: error; varname is inconsistent with VT_ORIGININDX - endif - enddo - - deallocate(fulldom3d) - !, fulldom1d - -end subroutine filter_to_restarts +integer, intent(in) :: member, ncid -!-------------------------------------------------------------------- +real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) +character(len=256) :: file_root +integer :: ivar +character(len=vtablenamelength) :: varname, dart_varname -subroutine add_halo_fulldom3d(fulldom3d) +character(len=*), parameter :: routine = 'filter_to_restarts' - ! Space for full domain field (read from filter_output.nc) - ! and halo around the full domain - real(r4), intent(inout) :: fulldom3d(1:nz_per_block, & - 1-nghost:nlat+nghost, & - 1-nghost:nlon+nghost) - - character(len=*), parameter :: routine = 'add_halo_fulldom3d' - integer :: g, i,j, haflat,haflon - real(r4), allocatable :: normed(:,:) - character(len=16) :: debug_format - - ! An array for debugging by renormalizing an altitude of fulldom3d. - allocate(normed(1-nghost:nlat+nghost, & +! Space for full domain field (read from filter_output.nc) +! and halo around the full domain +allocate(fulldom3d(1:nlev, & + 1-nghost:nlat+nghost, & 1-nghost:nlon+nghost)) - - haflat = nlat/2 - haflon = nlon/2 - - do g = 1,nghost - ! left; reach around the date line. - ! There's no data at the ends of the halos for this copy. - fulldom3d (:,1:nlat, 1-g) & - = fulldom3d(:,1:nlat,nlon+1-g) - - ! right - fulldom3d (:,1:nlat,nlon+g) & - = fulldom3d(:,1:nlat,g) - - ! bottom; reach over the S Pole for halo values. - ! There is data at the ends of the halos for these.) - - fulldom3d (:,1-g ,1-nghost :haflon) & - = fulldom3d(:, g ,1-nghost+haflon:nlon) - fulldom3d (:,1-g ,haflon+1:nlon) & - = fulldom3d(:, g ,1 :haflon) - ! Last 2 (halo) points on the right edge (at the bottom) - fulldom3d (:,1-g , nlon+1: nlon+nghost) & - = fulldom3d(:, g ,haflon+1:haflon+nghost) - - ! top - fulldom3d (:,nlat +g ,1-nghost :haflon) & - = fulldom3d(:,nlat+1-g ,1-nghost+haflon:nlon) - fulldom3d (:,nlat +g ,haflon+1:nlon) & - = fulldom3d(:,nlat+1-g ,1 :haflon) - ! Last 2 (halo) points on the right edge (at the top) - fulldom3d (:,nlat +g , nlon+1: nlon+nghost) & - = fulldom3d(:,nlat+1-g ,haflon+1:haflon+nghost) - enddo - - if (any(fulldom3d == MISSING_R4)) then - error_string_1 = 'ERROR: some fulldom3d contain MISSING_R4 after halos' - call error_handler(E_ERR,routine,error_string_1,source,revision,revdate) + +! get the dirname, construct the filenames inside open_block_file + +! >>> TODO: Not all fields have halos suitable for calculating gradients. +! These do (2023-11-8): neutrals; temperature, O, O2, N2, and the horizontal winds. +! ions; none. +! The current model_mod will fill all neutral halos anyway, +! since that's simpler and won't break the model. +! TODO: add an attribute to the variables (?) to denote whether a field +! should have its halo filled. +do ivar = 1, nvar_neutral + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + if (debug >= 0 .and. do_output()) then + write(error_string_1,'("varname = ",A)') trim(varname) + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) endif - - ! TODO: Keep halo corners check for future use? - ! Add more robust rescaling. - ! Debug; print the 4x4 arrays (corners & middle) - ! to see whether values are copied correctly - ! Level 44 values range from 800-eps to 805. I don't want to see the 80. - ! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. - ! 2023-12-20; Aaron sent new files with 54 levels. - if (debug >= 100 .and. do_output()) then - if (fulldom3d(54,10,10) > 1.e+10) then - normed = fulldom3d(54,:,:) - 1.1092e+10 - debug_format = '(3(4E10.4,2X))' - else if (fulldom3d(54,10,10) < 1000._r4) then - normed = fulldom3d(54,:,:) - 800._r4 - debug_format = '(3(4F10.5,2X))' - endif - - ! Debug HDF5 - write(error_string_1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))') normed(nlat+1,nlon+2) - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) + dart_varname = aether_name_to_dart(varname) + + file_root = trim(variables(VT_ORIGININDX,ivar)) + if (file_root == 'neutrals') then + ! This parameter is available through the `use netcdf` command. + fulldom3d = NF90_FILL_REAL - ! 17 format debug_format - print*,'top' - do j = nlat+2,nlat-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) - enddo - print*,'middle' - do j = haflat+2,haflat-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) - enddo - print*,'bottom' - do j = 2,-1, -1 - write(*,debug_format) (normed(j,i),i= -1, 2), & - (normed(j,i),i=haflon-1,haflon+2), & - (normed(j,i),i= nlon-1, nlon+2) - enddo + call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & + nc_count=(/ nlev,nlat,nlon,1 /), context=routine) + ! TODO: ncount not needed? Reading the whole field. + + ! Copy updated field values to full domain halo. + ! Block domains+halos will be easily read from this. + call add_halo_fulldom3d(fulldom3d) + + call filter_io_to_blocks(fulldom3d, varname, file_root, member) + else + ! TODO: error; varname is inconsistent with VT_ORIGININDX + endif + +enddo + +do ivar = nvar_neutral + 1, nvar_neutral + nvar_ion + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + dart_varname = aether_name_to_dart(varname) + + file_root = trim(variables(VT_ORIGININDX,ivar)) + if (debug >= 0 .and. do_output()) then + write(error_string_1,'("varname, dart_varname, file_root = ",3(2x,A))') & + trim(varname), trim(dart_varname), file_root + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + endif + + if (file_root == 'ions') then + fulldom3d = NF90_FILL_REAL + call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & + nc_count=(/ nlev,nlat,nlon,1 /), context=routine) + !? ncount not needed? Reading the whole field. + + ! 2023-11: ions do not have real or used data in their halos. + ! Make this clear by leaving the halos filled with MISSING_R4 + ! TODO: Will this be translated into NetCDF missing_value? + ! call add_halo_fulldom3d(fulldom3d) + + call filter_io_to_blocks(fulldom3d, varname, file_root, member) + + else + ! TODO: error; varname is inconsistent with VT_ORIGININDX + endif +enddo + +deallocate(fulldom3d) +!, fulldom1d + +end subroutine filter_to_restarts + +!----------------------------------------------------------------------- +! Copy updated data from the full domain into the halo regions, +! in preparation for extracting haloed blocks into the block restart files. +! First the halos past the East and West edges are taken from the wrap-around points. +! The halos beyond the edge latitudes in the North and South +! are taken by reaching over the pole to a longitude that's half way around the globe. +! This is independent of the number of blocks. + +subroutine add_halo_fulldom3d(fulldom3d) + +! Space for full domain field (read from filter_output.nc) +! and halo around the full domain +real(r4), intent(inout) :: fulldom3d(1:nz_per_block, & + 1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost) + +integer :: g, i, j, haflat, haflon +real(r4), allocatable :: normed(:,:) +character(len=16) :: debug_format + +character(len=*), parameter :: routine = 'add_halo_fulldom3d' + +! An array for debugging by renormalizing an altitude of fulldom3d. +allocate(normed(1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost)) + +haflat = nlat / 2 +haflon = nlon / 2 + +do g = 1,nghost + ! left; reach around the date line. + ! There's no data at the ends of the halos for this copy. + fulldom3d (:,1:nlat, 1-g) & + = fulldom3d(:,1:nlat,nlon+1-g) + + ! right + fulldom3d (:,1:nlat,nlon+g) & + = fulldom3d(:,1:nlat,g) + + ! bottom; reach over the S Pole for halo values. + ! There is data at the ends of the halos for these.) + + fulldom3d (:, 1-g ,1-nghost :haflon) & + = fulldom3d(:, g ,1-nghost+haflon:nlon) + fulldom3d (:, 1-g ,haflon+1:nlon) & + = fulldom3d(:, g , 1:haflon) + ! Last 2 (halo) points on the right edge (at the bottom) + fulldom3d (:, 1-g , nlon+1: nlon+nghost) & + = fulldom3d(:, g ,haflon+1:haflon+nghost) + + ! top + fulldom3d (:, nlat +g, 1-nghost :haflon) & + = fulldom3d(:, nlat+1-g, 1-nghost+haflon:nlon) + fulldom3d (:, nlat +g, haflon+1:nlon) & + = fulldom3d(:, nlat+1-g, 1:haflon) + ! Last 2 (halo) points on the right edge (at the top) + fulldom3d (:, nlat +g, nlon+1: nlon+nghost) & + = fulldom3d(:, nlat+1-g, haflon+1:haflon+nghost) +enddo + +if (any(fulldom3d == MISSING_R4)) then + error_string_1 = 'ERROR: some fulldom3d contain MISSING_R4 after halos' + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +endif + +! TODO: Keep halo corners check for future use? +! Add more robust rescaling. +! Debug; print the 4x4 arrays (corners & middle) +! to see whether values are copied correctly +! Level 44 values range from 800-eps to 805. I don't want to see the 80. +! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. +! 2023-12-20; Aaron sent new files with 54 levels. +if (debug >= 100 .and. do_output()) then + if (fulldom3d(54,10,10) > 1.e+10) then + normed = fulldom3d(54,:,:) - 1.1092e+10 + debug_format = '(3(4E10.4,2X))' + else if (fulldom3d(54,10,10) < 1000._r4) then + normed = fulldom3d(54,:,:) - 800._r4 + debug_format = '(3(4F10.5,2X))' endif - deallocate(normed) + ! Debug HDF5 + write(error_string_1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))') normed(nlat+1,nlon+2) + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) - end subroutine add_halo_fulldom3d + ! 17 format debug_format + print*,'top' + do j = nlat+2, nlat-1, -1 + write(*,debug_format) (normed(j,i), i= -1, 2), & + (normed(j,i), i=haflon-1,haflon+2), & + (normed(j,i), i= nlon-1, nlon+2) + enddo + print*,'middle' + do j = haflat+2, haflat-1 , -1 + write(*,debug_format) (normed(j,i), i= -1, 2), & + (normed(j,i), i=haflon-1,haflon+2), & + (normed(j,i), i= nlon-1, nlon+2) + enddo + print*,'bottom' + do j = 2,-1, -1 + write(*,debug_format) (normed(j,i), i= -1, 2), & + (normed(j,i), i=haflon-1,haflon+2), & + (normed(j,i), i= nlon-1, nlon+2) + enddo +endif -!-------------------------------------------------------------------- +deallocate(normed) + +end subroutine add_halo_fulldom3d + +!----------------------------------------------------------------------- ! Transfer part of the full field into a block restart file. - subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) +subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) - real(r4), intent(in) :: fulldom3d(1:nz_per_block, & - 1-nghost:nlat+nghost, & - 1-nghost:nlon+nghost, 1) - character(len=*), intent(in) :: varname - character(len=*), intent(in) :: file_root - integer, intent(in) :: member - - ! Don't collect velocity components (6 of them) - ! real(r4) :: temp0d - ! , temp1d(:) ? - integer :: ncid_output - integer :: ib, jb, nb - integer :: starts(3),ends(3), xcount, ycount, zcount - character(len=256) :: block_file - character(len=*), parameter :: routine = 'filter_io_to_blocks' - - ! a temp array large enough to hold any of the - ! Lon,Lat or Alt array from a block plus ghost cells - ! allocate(temp1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) - - - zcount = nz_per_block - ycount = ny_per_block + 2*nghost - xcount = nx_per_block + 2*nghost - - - if (debug > 0 .and. do_output()) then - write(error_string_1,'(A,I0,A,I0,A)') 'Now putting the data for ',nblocks_lon, & - ' blocks lon by ',nblocks_lat,' blocks lat' - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - end if - - starts(1) = 1 - ends(1) = nz_per_block - - do jb = 1, nblocks_lat - starts(2) = (jb-1)*ny_per_block - nghost + 1 - ends(2) = jb *ny_per_block + nghost - - do ib = 1, nblocks_lon - starts(3) = (ib-1)*nx_per_block - nghost + 1 - ends(3) = ib *nx_per_block + nghost - - nb = (jb-1) * nblocks_lon + ib - 1 - - block_file = block_file_name(trim(file_root), member, nb) - ncid_output = open_block_file(block_file, 'readwrite') - - ! TODO: error checking; does the block file have the field in it? - if ( debug > 0 .and. do_output()) then - write(error_string_1,'(A,3(2X,i5))') "block, ib, jb = ", nb, ib, jb - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - write(error_string_1,'(3(A,3i5))') & - 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount - call error_handler(E_MSG,routine,error_string_1,source,revision,revdate) - endif - - call nc_put_variable(ncid_output, trim(varname), & - fulldom3d(starts(1):ends(1), starts(2):ends(2), starts(3):ends(3), 1:1), & - context=routine, nc_count=(/zcount,ycount,xcount,1/) ) - - call nc_close_file(ncid_output) - - enddo - enddo - - ! - ! TODO: ? Add f107 and Rho to the restart files - ! call read_filter_io_block0d(ncid, ivals(1), data0d) - ! if (data0d < 0.0_r8) data0d = 60.0_r8 !alex - ! write(ounit) data0d - - end subroutine filter_io_to_blocks +real(r4), intent(in) :: fulldom3d(1:nz_per_block, & + 1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost ) +character(len=*), intent(in) :: varname +character(len=*), intent(in) :: file_root +integer, intent(in) :: member + +! Don't collect velocity components (6 of them) +! real(r4) :: temp0d +! , temp1d(:) ? +integer :: ncid_output +integer :: ib, jb, nb +integer :: starts(3), ends(3), xcount, ycount, zcount +character(len=256) :: block_file + +character(len=*), parameter :: routine = 'filter_io_to_blocks' +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +! allocate(temp1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) -!=================================================================== +zcount = nz_per_block +ycount = ny_per_block + (2 * nghost) +xcount = nx_per_block + (2 * nghost) + + +if (debug > 0 .and. do_output()) then + write(error_string_1,'(A,I0,A,I0,A)') 'Now putting the data for ', nblocks_lon, & + ' blocks lon by ',nblocks_lat,' blocks lat' + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +end if + +starts(1) = 1 +ends(1) = nz_per_block + +do jb = 1, nblocks_lat + starts(2) = (jb - 1) * ny_per_block - nghost + 1 + ends(2) = jb * ny_per_block + nghost + + do ib = 1, nblocks_lon + starts(3) = (ib - 1) * nx_per_block - nghost + 1 + ends(3) = ib * nx_per_block + nghost + + nb = (jb - 1) * nblocks_lon + ib - 1 + + block_file = block_file_name(trim(file_root), member, nb) + ncid_output = open_block_file(block_file, 'readwrite') + + ! TODO: error checking; does the block file have the field in it? + if ( debug > 0 .and. do_output()) then + write(error_string_1,'(A,3(2X,i5))') "block, ib, jb = ", nb, ib, jb + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + write(error_string_1,'(3(A,3i5))') & + 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + endif + + call nc_put_variable(ncid_output, trim(varname), & + fulldom3d(starts(1):ends(1), starts(2):ends(2), starts(3):ends(3)), & + context=routine, nc_count=(/ zcount,ycount,xcount /) ) + + call nc_close_file(ncid_output) + + enddo +enddo + +! +! TODO: ? Add f107 and Rho to the restart files +! call read_filter_io_block0d(ncid, ivals(1), data0d) +! if (data0d < 0.0_r8) data0d = 60.0_r8 !alex +! write(ounit) data0d + +end subroutine filter_io_to_blocks + +!----------------------------------------------------------------------- ! End of model_mod -!=================================================================== +!----------------------------------------------------------------------- end module model_mod From 0b00da4e7195fce185a47034b633df8543642301 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Mon, 29 Jan 2024 10:56:43 -0700 Subject: [PATCH 063/124] Updated active code to be closer to the style guide. Replace hard coded routine name args with local variable 'routine' remove unused procedures from 'use' check_use_routines.csh Check routine local variables for definition with a value, dimension(:,...) :: variable -> :: variable(:,...) Named loops if they're > 1 page, have a 'cycle' or 'exit', or loop over non-array-indices error handler character output should be formatted with '(A)', not * Capitalization; replace CamelCase with multi_word constants need _r8 Still to do Capitalization ? parameters can (should?) be ALL_CAPS. Not consistent in DART (types_mod has ALL_CAPS, ALLCAPS, alllowercase and multi_word) use parameters from types_mod.f90; varnamelength = 31, metadatalength = 64 ? Are these up-to-date with the fortran we're using? ? Should we use parameters that have the right value in contexts where the name is misleading? character(len=varnamelength) :: calendar = 'GREGORIAN' Or define additional length parameters for this module in the global defs? filter_to_restarts: no nc_count?, add error message Look into precision of dimension vars (lons, lats, levs) --- models/aether_lon-lat/model_mod.f90 | 260 ++++++++++++++-------------- 1 file changed, 126 insertions(+), 134 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index d502c4e493..0600213c1f 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -22,11 +22,11 @@ module model_mod location_type, get_close_type, & loc_get_close_obs => get_close_obs, & loc_get_close_state => get_close_state, & - is_vertical, set_location, set_location_missing, & + is_vertical, set_location, & VERTISHEIGHT, query_location, get_location use utilities_mod, only : & - open_file, close_file, file_exist, logfileunit, register_module, & + open_file, close_file, file_exist, register_module, & error_handler, E_ERR, E_MSG, E_WARN, & nmlfileunit, do_output, do_nml_file, do_nml_term, & find_namelist_in_file, check_namelist_read, to_upper, & @@ -197,7 +197,7 @@ module model_mod !----------------------------------------------------------------------- ! Day 0 in Aether's calendar is (+/1 a day) -4710/11/24 0 UTC -! integer :: aether_ref_day = 2451545.0 ! cJULIAN2000 in Aether = day of date 2000/01/01. +! integer :: aether_ref_day = 2451545.0_r8 ! cJULIAN2000 in Aether = day of date 2000/01/01. character(len=32) :: calendar = 'GREGORIAN' ! But what we care about is the ref time for the times in the files, which is 1965-1-1 00:00 @@ -340,7 +340,7 @@ subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs which_vert = nint(query_location(location)) IF (debug > 85) then - write(error_string_1,*) 'requesting interpolation at ', llon, llat, lvert + write(error_string_1,'(A,3F15.4)') 'requesting interpolation at ', llon, llat, lvert call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) end if @@ -366,7 +366,8 @@ subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs if (status1 /= 0) then if(debug > 12) then - write(error_string_1,*) 'Did not find observation quantity ', qty, ' in the state vector' + write(error_string_1,'(A,I5,A)') 'Did not find observation quantity ', qty, & + ' in the state vector' call error_handler(E_WARN, routine, error_string_1, source, revision, revdate) endif istatus(:) = status1 ! this quantity not in the state vector @@ -422,12 +423,11 @@ subroutine get_state_meta_data(index_in, location, qty) type(location_type), intent(out) :: location integer, optional , intent(out) :: qty -character(len=*), parameter :: routine = 'get_state_meta_data' - ! Local variables integer :: lat_index, lon_index, lev_index integer :: my_var_id, my_qty +! character(len=*), parameter :: routine = 'get_state_meta_data' if ( .not. module_initialized ) call static_init_model @@ -461,7 +461,7 @@ subroutine get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & real(r8), optional, intent(out) :: dist(:) ! distances in radians type(ensemble_type), optional, intent(in) :: ens_handle -character(len=*), parameter :: routine = 'get_close_obs' +! character(len=*), parameter :: routine = 'get_close_obs' call loc_get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & num_close, close_ind, dist, ens_handle) @@ -485,7 +485,7 @@ subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & real(r8), optional, intent(out) :: dist(:) ! distances in radians type(ensemble_type), optional, intent(in) :: ens_handle -character(len=*), parameter :: routine = 'get_close_state' +! character(len=*), parameter :: routine = 'get_close_state' call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & @@ -599,26 +599,26 @@ subroutine assign_dimensions(filter_io_filename, levs, lats, lons, nlev, nlat, n integer, intent(out) :: nlev, nlat, nlon integer :: ncid -character(len=24), parameter :: ROUTINE = 'assign_dimensions' +character(len=24), parameter :: routine = 'assign_dimensions' -call error_handler(E_MSG, ROUTINE, 'reading filter input ['//trim(filter_io_filename)//']') +call error_handler(E_MSG, routine, 'reading filter input ['//trim(filter_io_filename)//']') -ncid = nc_open_file_readonly(filter_io_filename, ROUTINE) +ncid = nc_open_file_readonly(filter_io_filename, routine) ! levels -nlev = nc_get_dimension_size(ncid, trim(LEV_DIM_NAME), ROUTINE) +nlev = nc_get_dimension_size(ncid, trim(LEV_DIM_NAME), routine) allocate(levs(nlev)) -call nc_get_variable(ncid, trim(LEV_VAR_NAME), levs, ROUTINE) +call nc_get_variable(ncid, trim(LEV_VAR_NAME), levs, routine) ! latitiude -nlat = nc_get_dimension_size(ncid, trim(LAT_DIM_NAME), ROUTINE) +nlat = nc_get_dimension_size(ncid, trim(LAT_DIM_NAME), routine) allocate(lats(nlat)) -call nc_get_variable(ncid, trim(LAT_VAR_NAME), lats, ROUTINE) +call nc_get_variable(ncid, trim(LAT_VAR_NAME), lats, routine) ! longitude -nlon = nc_get_dimension_size(ncid, trim(LON_DIM_NAME), ROUTINE) +nlon = nc_get_dimension_size(ncid, trim(LON_DIM_NAME), routine) allocate(lons(nlon)) -call nc_get_variable(ncid, trim(LON_VAR_NAME), lons, ROUTINE) +call nc_get_variable(ncid, trim(LON_VAR_NAME), lons, routine) end subroutine assign_dimensions @@ -648,7 +648,7 @@ subroutine verify_variables(variables, file, nvar, & character(len=vtablenamelength) :: state_or_aux nvar = 0 -MyLoop : do i = 1, size(variables,2) +MY_LOOP : do i = 1, size(variables,2) ! TODO Why define these intermediate strings? Is the code clearer or faster? varname = variables(VT_VARNAMEINDX,i) @@ -657,7 +657,7 @@ subroutine verify_variables(variables, file, nvar, & maxvalstring = variables(VT_MAXVALINDX,i) state_or_aux = variables(VT_STATEINDX,i) - if ( varname == ' ' .and. dartstr == ' ' ) exit MyLoop ! Found end of list. + if ( varname == ' ' .and. dartstr == ' ' ) exit MY_LOOP ! Found end of list. if ( varname == ' ' .or. dartstr == ' ' ) then error_string_1 = 'model_nml: variable list not fully specified' @@ -696,7 +696,7 @@ subroutine verify_variables(variables, file, nvar, & call to_upper(state_or_aux) if (state_or_aux == 'UPDATE') var_update(nvar) = .true. -enddo MyLoop +enddo MY_LOOP if (nvar == MAX_STATE_VARIABLES) then error_string_1 = 'WARNING: you may need to increase "MAX_STATE_VARIABLES"' @@ -721,9 +721,8 @@ subroutine get_quad_vals(state_handle, ens_size, varid, four_lons, four_lats, & real(r8), intent(out) :: quad_vals(4, ens_size) integer, intent(out) :: istatus(ens_size) -real(r8) :: vert_val -integer :: lev1, lev2, stat, integer_level -real(r8) :: vert_fract +integer :: lev1, lev2, stat +real(r8) :: vert_val, vert_fract character(len=512) :: error_string_1 character(len=*), parameter :: routine = 'get_quad_vals' @@ -814,8 +813,8 @@ subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & four_lons(icorner), dom_id, varid) if (state_indx < 0) then - write(error_string_1,*) 'Could not find dart state index from ' - write(error_string_2,*) 'lon, lat, and lev1 index :', & + write(error_string_1,'(A)') 'Could not find dart state index from ' + write(error_string_2,'(A,3F15.4)') 'lon, lat, and lev1 index :', & four_lons(icorner), four_lats(icorner), lev1 call error_handler(E_ERR, routine, error_string_1, source, revision, revdate, & text2=error_string_2) @@ -828,8 +827,8 @@ subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & four_lons(icorner), dom_id, varid) if (state_indx < 0) then - write(error_string_1,*) 'Could not find dart state index from ' - write(error_string_2,*) 'lon, lat, and lev2 index :', & + write(error_string_1,'(A)') 'Could not find dart state index from ' + write(error_string_2,'(A,3F15.4)') 'lon, lat, and lev2 index :', & four_lons(icorner), four_lats(icorner), lev2 call error_handler(E_ERR, routine, error_string_1, source, revision, revdate, & text2=error_string_2) @@ -892,9 +891,9 @@ end subroutine ok_to_interpolate ! ! In the process, the routine will find: ! -! 1. The number of blocks in Lon and Lat (nBlocksLon, nBlocksLat) +! 1. The number of blocks in Lon and Lat (nblocks_lon, nblocks_lat) ! -! 2. The number of lons and lats in a single grid block (nxPerBlock, nyPerBlock, nzPerBlock) +! 2. The number of lons and lats in a single grid block (nx_per_block, ny_per_block, nz_per_block) ! ! 3. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. ! @@ -916,7 +915,7 @@ subroutine restart_files_to_netcdf(member) character(len=*), parameter :: routine = 'restart_files_to_netcdf' if (module_initialized ) then - write(error_string_1,*)'The aether static_init_model was already initialized but ', & + write(error_string_1,'(3A)')'The aether static_init_model was already initialized but ', & trim(routine), ' uses a separate initialization procedure' call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) end if @@ -928,9 +927,9 @@ subroutine restart_files_to_netcdf(member) ncid = nc_create_file(filter_io_filename) call error_handler(E_MSG, '', '') -write(error_string_1,*) 'converting Aether restart files in directory ', & +write(error_string_1,'(3A)') 'converting Aether restart files in directory ', & "'"//trim(aether_restart_dirname)//"'" -write(error_string_2,*) ' to the NetCDF file ', "'"//trim(filter_io_filename)//"'" +write(error_string_2,'(3A)') ' to the NetCDF file ', "'"//trim(filter_io_filename)//"'" call error_handler(E_MSG, routine, error_string_1, text2=error_string_2) call error_handler(E_MSG, '', '') @@ -954,7 +953,7 @@ subroutine restart_files_to_netcdf(member) call nc_close_file(ncid) call error_handler(E_MSG, '', '') -write(error_string_1,*) 'Successfully converted the Aether restart files to ', & +write(error_string_1,'(3A)') 'Successfully converted the Aether restart files to ', & "'"//trim(filter_io_filename)//"'" call error_handler(E_MSG, routine, error_string_1) call error_handler(E_MSG, '', '') @@ -976,7 +975,7 @@ subroutine netcdf_to_restart_files(member) ! when this routine returns all the data has been written. if (module_initialized ) then - write(error_string_1,*)'The aether mod was already initialized but ', & + write(error_string_1,'(3A)')'The aether mod was already initialized but ', & trim(routine), ' uses a separate initialization procedure' call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) end if @@ -986,8 +985,8 @@ subroutine netcdf_to_restart_files(member) write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member + 1,'.nc' call error_handler(E_MSG, routine, '', '', revision, revdate) -write(error_string_1,*) 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" -write(error_string_2,*) 'into Aether restart files in directory ', & +write(error_string_1,'(3A)') 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" +write(error_string_2,'(3A)') 'into Aether restart files in directory ', & "'"//trim(aether_restart_dirname)//"'" call error_handler(E_MSG, routine, error_string_1, source, revision, revdate, text2=error_string_2) @@ -999,8 +998,8 @@ subroutine netcdf_to_restart_files(member) ! Log what we think we're doing, and exit. !---------------------------------------------------------------------- call error_handler(E_MSG, routine,'','', revision, revdate) -write(error_string_1,*) 'Successfully converted to the Aether restart files in directory' -write(error_string_2,*) "'"//trim(aether_restart_dirname)//"'" +write(error_string_1,'(3A)') 'Successfully converted to the Aether restart files in directory' +write(error_string_2,'(3A)') "'"//trim(aether_restart_dirname)//"'" call error_handler(E_MSG, routine, error_string_1, source, revision, revdate, text2=error_string_2) call nc_close_file(ncid) @@ -1044,9 +1043,8 @@ subroutine static_init_blocks(nml) character(len=*), intent(in) :: nml -character(len=128) :: aether_filter_io_filename -character(len=vtablenamelength) :: varname -integer :: iunit, io, ivar +character(len=128) :: aether_filter_io_filename +integer :: iunit, io character(len=*), parameter :: routine = 'static_init_blocks' @@ -1077,7 +1075,7 @@ subroutine static_init_blocks(nml) ! 'variables' comes from the namelist in input.nml call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) -!--------------------------------------------------------------- +!-------------------------------- ! TODO: Set the time step ! Ensures model_advance_time is multiple of 'dynamics_timestep' @@ -1085,7 +1083,7 @@ subroutine static_init_blocks(nml) ! (days from the start of the calendar), depending on the context) call set_calendar_type( calendar ) -!--------------------------------------------------------------- +!-------------------------------- ! 1) get grid dimensions ! 2) allocate space for the grids ! 3) read them from the block restart files, could be stretched ... @@ -1094,13 +1092,14 @@ subroutine static_init_blocks(nml) nblocks_lat, nblocks_lev, lat_start, lat_end, lon_start) if( debug > 0 ) then - write(error_string_1,*) 'grid dims are ', nlon, nlat, nlev + write(error_string_1,'(A,3I5)') 'grid dims are ', nlon, nlat, nlev call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) endif ! Opens and closes the grid block file, but not the filter netcdf file. call get_grid_from_blocks(aether_restart_dirname, nblocks_lon, nblocks_lat, nblocks_lev, & - nx_per_block, ny_per_block, nz_per_block, lons, lats, levs ) + nx_per_block, ny_per_block, nz_per_block) +! , lons, lats, levs ) ! Convert the Aether reference date (not calendar day = 0 date) ! to the days and seconds of the calendar set in model_mod_nml. @@ -1133,7 +1132,7 @@ subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & integer, intent(out) :: nblocks_lon, nblocks_lat, nblocks_lev real(r8), intent(out) :: lat_start, lat_end, lon_start -character(len=100) :: cline ! iCharLen_ == 100 +character(len=100) :: c_line character(len=256) :: file_loc integer :: i, iunit, ios @@ -1156,7 +1155,7 @@ subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & write(file_loc,'(a,''/'',a)') trim(restart_dirname), trim(filename) if (debug > 4) then -write(error_string_1,*) 'Now opening Aether UAM file: ', trim(file_loc) +write(error_string_1,'(3A)') 'Now opening Aether UAM file: ', trim(file_loc) call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) end if @@ -1165,16 +1164,16 @@ subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & UAMREAD : do i = 1, 1000000 -read(iunit,'(a)',iostat=ios) cLine +read(iunit,'(a)',iostat=ios) c_line if (ios /= 0) then ! If we get to the end of the file or hit a read error without ! finding what we need, die. -write(error_string_1,*) 'cannot find #GRID in ', trim(file_loc) -call error_handler(E_ERR,'get_grid_info_from_blocks', error_string_1, source, revision, revdate) +write(error_string_1,'(3A)') 'cannot find #GRID in ', trim(file_loc) +call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) endif -if (cLine(1:5) .ne. "#GRID") cycle UAMREAD +if (c_line(1:5) .ne. "#GRID") cycle UAMREAD nblocks_lon = read_in_int( iunit,'nblocks_lon', trim(file_loc)) nblocks_lat = read_in_int( iunit,'nblocks_lat', trim(file_loc)) @@ -1188,19 +1187,19 @@ subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & enddo UAMREAD if (debug > 4) then -write(error_string_1,*) 'Successfully read Aether UAM grid file:', trim(file_loc) +write(error_string_1,'(3A)') 'Successfully read Aether UAM grid file:', trim(file_loc) call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) -write(error_string_1,*) ' nblocks_lon:', nblocks_lon +write(error_string_1,'(A,I5)') ' nblocks_lon:', nblocks_lon call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) -write(error_string_1,*) ' nblocks_lat:', nblocks_lat +write(error_string_1,'(A,I5)') ' nblocks_lat:', nblocks_lat call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) -write(error_string_1,*) ' nblocks_lev:', nblocks_lev +write(error_string_1,'(A,I5)') ' nblocks_lev:', nblocks_lev call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) -write(error_string_1,*) ' lat_start:', lat_start +write(error_string_1,'(A,F15.4)') ' lat_start:', lat_start call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) -write(error_string_1,*) ' lat_end:', lat_end +write(error_string_1,'(A,F15.4)') ' lat_end:', lat_end call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) -write(error_string_1,*) ' lon_start:', lon_start +write(error_string_1,'(A,F15.4)') ' lon_start:', lon_start call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) end if @@ -1213,8 +1212,9 @@ end subroutine get_grid_info_from_blocks ! Allocate and fill the full-domain 1-D dimension arrays (lon, lat, levs) subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, & - nx_per_block, ny_per_block, nz_per_block, & - lons, lats, levs ) + nx_per_block, ny_per_block, nz_per_block) +! , & +! lons, lats, levs ) character(len=*), intent(in) :: dirname integer, intent(in) :: nblocks_lon ! Number of Longitude blocks @@ -1223,9 +1223,9 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, integer, intent(out) :: nx_per_block ! Number of non-halo Longitude centers per block integer, intent(out) :: ny_per_block ! Number of non-halo Latitude centers per block integer, intent(out) :: nz_per_block ! Number of Vertical grid centers -real(r8), allocatable, dimension, intent(inout) :: lons(:), lats(:), levs(:) +! real(r8), allocatable, intent(inout) :: lons(:), lats(:), levs(:) -integer :: ios, nb, offset, ncid, nboff +integer :: nb, offset, ncid, nboff integer :: starts(3), ends(3), xcount, ycount, zcount character(len=128) :: filename real(r4), allocatable :: temp(:,:,:) @@ -1233,7 +1233,7 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, character(len=*), parameter :: routine = 'get_grid_from_blocks' ! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), -! in order to calculate the n[xyz]PerBlock dimensions. +! in order to calculate the n[xyz]_per_block dimensions. ! grid_g0000.nc looks like a worthy candidate, but a restart could be used. write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' ncid = nc_open_file_readonly(filename, routine) @@ -1248,11 +1248,11 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, nlat = nblocks_lat * ny_per_block nlev = nblocks_lev * nz_per_block -write(error_string_1,*) 'nlon = ', nlon +write(error_string_1,'(A,I5)') 'nlon = ', nlon call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) -write(error_string_1,*) 'nlat = ', nlat +write(error_string_1,'(A,I5)') 'nlat = ', nlat call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) -write(error_string_1,*) 'nlev = ', nlev +write(error_string_1,'(A,I5)') 'nlev = ', nlev call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) ! TODO; do these need to be deallocated somewhere? @@ -1263,13 +1263,13 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, allocate( levs( nlev )) if (debug > 4) then - write(error_string_1,*) 'Successfully read Aether grid file:', trim(filename) + write(error_string_1,'(2A)') 'Successfully read Aether grid file:', trim(filename) call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) - write(error_string_1,*) ' nx_per_block:', nx_per_block + write(error_string_1,'(A,I5)') ' nx_per_block:', nx_per_block call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) - write(error_string_1,*) ' ny_per_block:', ny_per_block + write(error_string_1,'(A,I5)') ' ny_per_block:', ny_per_block call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) - write(error_string_1,*) ' nz_per_block:', nz_per_block + write(error_string_1,'(A,I5)') ' nz_per_block:', nz_per_block call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) endif @@ -1367,11 +1367,11 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, endif if ( debug > 1 ) then ! Check dimension limits - write(error_string_1,*)'LON range ', minval(lons), maxval(lons) + write(error_string_1,'(A,2F15.4)') 'LON range ', minval(lons), maxval(lons) call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) - write(error_string_1,*)'LAT range ', minval(lats), maxval(lats) + write(error_string_1,'(A,2F15.4)') 'LAT range ', minval(lats), maxval(lats) call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) - write(error_string_1,*)'ALT range ', minval(levs), maxval(levs) + write(error_string_1,'(A,2F15.4)') 'ALT range ', minval(levs), maxval(levs) call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) endif @@ -1411,11 +1411,11 @@ function read_aether_time(filename) call print_date(read_aether_time, routine//': date in restart file '//filename) if (debug > 8) then - write(error_string_1,*)'tsimulation ', tsimulation + write(error_string_1,'(A,I5)')'tsimulation ', tsimulation call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) - write(error_string_1,*)'ndays ', ndays + write(error_string_1,'(A,I5)')'ndays ', ndays call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) - write(error_string_1,*)'nsecs ', nsecs + write(error_string_1,'(A,I5)')'nsecs ', nsecs call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) call print_date(aether_ref_time, routine//':model base date') @@ -1448,7 +1448,7 @@ function aether_name_to_dart(varname) var_root = aether(char_num+1:aether_len) ! purge_chars removes unwanted [()\] parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) -! TODO: keep aether_name_to_dart diagnostic? +! TODO: keep aether_name_to_dart diagnostic? Then add routine, error_handler. ! print*,'var_root, parts(1) = ', var_root, parts(1) end_str = char_num @@ -1456,7 +1456,7 @@ function aether_name_to_dart(varname) char_num = MISSING_I first = 1 i_parts = 2 -Parts : do +P_LOOP: do ! This returns the position of the first blank *within the substring* passed in. char_num = scan(aether(first:end_str),' ', back=.false.) if (char_num > 0 .and. first < aether_len) then @@ -1465,9 +1465,9 @@ function aether_name_to_dart(varname) first = first + char_num i_parts = i_parts + 1 else - exit Parts + exit P_LOOP endif -enddo Parts +enddo P_LOOP ! Construct the DART field name from the parts aether_name_to_dart = trim(parts(1)) @@ -1546,13 +1546,13 @@ function open_block_file(filename, rw) character(len=*), parameter :: routine = 'open_block_file' if ( .not. file_exist(filename) ) then - write(error_string_1,*) 'cannot open file ', filename,' for ', rw + write(error_string_1,'(4A)') 'cannot open file ', filename,' for ', rw call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) endif if (debug > 0) then - write(error_string_1,*) 'Opening file ', trim(filename), ' for ', rw - call error_handler(E_MSG,'open_block_file', error_string_1, source, revision, revdate) + write(error_string_1,'(4A)') 'Opening file ', trim(filename), ' for ', rw + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) end if @@ -1562,13 +1562,13 @@ function open_block_file(filename, rw) open_block_file = nc_open_file_readwrite(filename, routine) else error_string_1 = ': must be called with rw={read,readwrite}, not '//rw - call error_handler(E_ERR,'open_block_file', error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) endif if (debug > 80) then - write(error_string_1,*) 'Returned file descriptor is ', open_block_file - call error_handler(E_MSG,'open_block_file', error_string_1, source, revision, revdate) + write(error_string_1,'(4A)') 'Returned file descriptor is ', open_block_file + call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) end if end function open_block_file @@ -1586,29 +1586,25 @@ subroutine restarts_to_filter(dirname, ncid_output, member, define) integer, intent(in) :: ncid_output, member logical, intent(in) :: define -integer :: ibLoop, jbLoop -integer :: ib, jb, nb, iunit - -character(len=256) :: filter_io_filename - +integer :: ib, jb, ib_loop, jb_loop if (define) then ! if define, run one block. ! the block_to_filter_io call defines the variables in the whole domain netCDF file. - ibLoop = 1 - jbLoop = 1 + ib_loop = 1 + jb_loop = 1 ! nc_write_model_atts puts it in define, and takes it out. call nc_begin_define_mode(ncid_output) else ! if not define, and run all blocks. ! the block_to_filter_io call adds the (ib,jb) block to a netCDF variable ! in order to make a file containing the data for all the blocks. - ibLoop = nblocks_lon - jbLoop = nblocks_lat + ib_loop = nblocks_lon + jb_loop = nblocks_lat end if -do jb = 1, jbLoop - do ib = 1, ibLoop +do jb = 1, jb_loop + do ib = 1, ib_loop call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) @@ -1631,26 +1627,27 @@ function read_in_real(iunit, varname, filter_io_filename) character(len=*), intent(in) :: varname, filter_io_filename real(r8) :: read_in_real -character(len=100) :: cLine +character(len=100) :: c_line integer :: i, ios +character(len=*), parameter :: routine = 'read_in_real' ! Read a line -read(iunit,'(a)',iostat=ios) cLine +read(iunit,'(a)',iostat=ios) c_line if (ios /= 0) then - write(error_string_1,*) 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'get_grid_dims', error_string_1, source, revision, revdate) + write(error_string_1,'(4A)') 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) endif ! Remove anything after a space or TAB -i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' -i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' +i=index(c_line,' '); if( i > 0 ) c_line(i:len(c_line))=' ' +i=index(c_line,char(9)); if( i > 0 ) c_line(i:len(c_line))=' ' ! Now that we have a line with nothing else ... parse it -read(cLine,*,iostat=ios) read_in_real +read(c_line,*,iostat=ios) read_in_real if(ios /= 0) then write(error_string_1,'(4A)')'unable to read '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'read_in_real', error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) endif end function read_in_real @@ -1665,26 +1662,27 @@ function read_in_int(iunit, varname, filter_io_filename) character(len=*), intent(in) :: varname, filter_io_filename integer :: read_in_int -character(len=100) :: cLine +character(len=100) :: c_line integer :: i, ios +character(len=*), parameter :: routine = 'read_in_int' ! Read a line -read(iunit,'(a)',iostat=ios) cLine +read(iunit,'(a)',iostat=ios) c_line if (ios /= 0) then - write(error_string_1,*) 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) + write(error_string_1,'(4A)') 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) call error_handler(E_ERR,'get_grid_dims', error_string_1, source, revision, revdate) endif ! Remove anything after a space or TAB -i=index(cLine,' '); if( i > 0 ) cLine(i:len(cLine))=' ' -i=index(cLine,char(9)); if( i > 0 ) cLine(i:len(cLine))=' ' +i=index(c_line,' '); if( i > 0 ) c_line(i:len(c_line))=' ' +i=index(c_line,char(9)); if( i > 0 ) c_line(i:len(c_line))=' ' -read(cLine,*,iostat=ios) read_in_int +read(c_line,*,iostat=ios) read_in_int if(ios /= 0) then write(error_string_1,'(4A)')'unable to read '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'read_in_int', error_string_1, source, revision, revdate, & - text2=cLine) + call error_handler(E_ERR, routine, error_string_1, source, revision, revdate, & + text2=c_line) endif end function read_in_int @@ -1693,26 +1691,22 @@ end function read_in_int ! Open all restart files (neutrals,ions) for a block and read in the requested data items. ! The write_filter_io calls will write the data to the filter_input.nc. -subroutine write_filter_io(data3d, varname, block, ncid) +subroutine write_filter_io(data3d, varname, ib, jb, ncid) real(r4), intent(in) :: data3d(1:nz_per_block, & 1-nghost:ny_per_block+nghost, & 1-nghost:nx_per_block+nghost) character(len=vtablenamelength), intent(in) :: varname -integer, intent(in) :: block(2) +integer, intent(in) :: ib, jb integer, intent(in) :: ncid -integer :: ib, jb integer :: starts(3) character(len=*), parameter :: routine = 'write_filter_io' ! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) -ib = block(1) -jb = block(2) - ! to compute the start, consider (ib-1)*nx_per_block+1 starts(1) = 1 starts(2) = (jb-1) * ny_per_block + 1 @@ -1746,10 +1740,10 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) -real(r4) :: temp0d -integer :: i, j, maxsize, ivar, nb, ncid_input -integer :: block(2) = 0 -logical :: no_idensity +integer :: ivar, nb, ncid_input +! TEC? integer :: maxsize +! logical :: no_idensity +! real(r4) :: temp0d character(len=32) :: att_val character(len=128) :: file_root character(len=256) :: filename @@ -1757,8 +1751,6 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) character(len=*), parameter :: routine = 'block_to_filter_io' -block(1) = ib -block(2) = jb ! The block number, as counted in Aether. ! Lower left is 0, increase to the East, then 1 row farther north, West to East. nb = (jb - 1) * nblocks_lon + ib - 1 @@ -1794,7 +1786,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! Do we want to use a temp4d array to handle them? ! They are independent variables in the block files (and state). ! ! temp array large enough to hold velocity vect, etc -! maxsize = max(3, nSpecies) +! maxsize = max(3, nvar_ion) ! allocate(temp4d(1-nghost:nx_per_block+nghost, & ! 1-nghost:ny_per_block+nghost, & ! 1-nghost:nz_per_block+nghost, maxsize)) @@ -1861,10 +1853,10 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) print*,'block_to_filter_io: temp3d = ', temp3d(1,1,1), temp3d(15,15,15), varname print*,'block_to_filter_io: define = ', define endif - call write_filter_io(temp3d, dart_varname, block, ncid_output) + call write_filter_io(temp3d, dart_varname, ib, jb, ncid_output) else - write(error_string_1,*) 'Trying to read neutrals, but variables(',VT_ORIGININDX,ivar , & - ') /= "neutrals"' + write(error_string_1,'(A,I3,A)') 'Trying to read neutrals, but variables(', & + VT_ORIGININDX,ivar , ') /= "neutrals"' call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) endif @@ -1888,17 +1880,17 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) end if call nc_define_real_variable(ncid_output, dart_varname, & - (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units', att_val, routine) print*, routine,': defined ivar, dart_varname, att = ', ivar, dart_varname, att_val else if (file_root == 'ions') then call nc_get_variable(ncid_input, varname, temp3d, context=routine) - call write_filter_io(temp3d, dart_varname, block, ncid_output) + call write_filter_io(temp3d, dart_varname, ib, jb, ncid_output) else - write(error_string_1,*) 'Trying to read ions, but variables(',VT_ORIGININDX,ivar , & - ') /= "ions"' + write(error_string_1,'(A,I3,A)') 'Trying to read ions, but variables(', & + VT_ORIGININDX,ivar , ') /= "ions"' call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) endif From 2a73453b2abb43e03a3f793c0646c35ce235dc90 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Mon, 29 Jan 2024 11:34:44 -0700 Subject: [PATCH 064/124] Removed nc_count from filter_to_restarts calls because it's reading whole arrays from filter_output.nc (into subsections of larger arrays). Removed unused variables from dart_to_aether.f90. Tested in aether_to_dart, dart_to_aether, and model_mod_check. --- models/aether_lon-lat/dart_to_aether.f90 | 3 +-- models/aether_lon-lat/model_mod.f90 | 7 +++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90 index dcea5b5715..1331e740a2 100644 --- a/models/aether_lon-lat/dart_to_aether.f90 +++ b/models/aether_lon-lat/dart_to_aether.f90 @@ -38,8 +38,7 @@ program dart_to_aether ! global storage !---------------------------------------------------------------------- -integer :: iunit, io, member -character(len=512) :: string1, string2 +integer :: member !---------------------------------------------------------------------- ! Get the ensemble member diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 0600213c1f..e21166635a 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -595,6 +595,7 @@ end subroutine def_fill_dimvars subroutine assign_dimensions(filter_io_filename, levs, lats, lons, nlev, nlat, nlon) character(len=*), intent(in) :: filter_io_filename +! TODO: conflict between lons,... being global storage and passed to assign_dimensions? real(r8), allocatable, intent(out) :: levs(:), lats(:), lons(:) integer, intent(out) :: nlev, nlat, nlon @@ -1977,7 +1978,8 @@ subroutine filter_to_restarts(ncid, member) fulldom3d = NF90_FILL_REAL call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & - nc_count=(/ nlev,nlat,nlon,1 /), context=routine) + context=routine) + ! nc_count=(/ nlev,nlat,nlon,1 /), context=routine) ! TODO: ncount not needed? Reading the whole field. ! Copy updated field values to full domain halo. @@ -2005,7 +2007,8 @@ subroutine filter_to_restarts(ncid, member) if (file_root == 'ions') then fulldom3d = NF90_FILL_REAL call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & - nc_count=(/ nlev,nlat,nlon,1 /), context=routine) + context=routine) + ! nc_count=(/ nlev,nlat,nlon,1 /), context=routine) !? ncount not needed? Reading the whole field. ! 2023-11: ions do not have real or used data in their halos. From 9bc73a76295870f5d5d97773eebab093a9de515f Mon Sep 17 00:00:00 2001 From: kdraeder Date: Mon, 29 Jan 2024 15:02:05 -0700 Subject: [PATCH 065/124] Added a netcdf module variable to the netcdf_utilities public list NF90_FILL_REAL is used to fill the halo regions of Aether with values that NetCDF will recognize as "not data". It's a pass-through variable in netcdf_utilities. --- assimilation_code/modules/utilities/netcdf_utilities_mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 b/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 index 74301bd6f4..667138cfe5 100644 --- a/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 +++ b/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 @@ -63,7 +63,7 @@ module netcdf_utilities_mod nc_begin_define_mode, & nc_end_define_mode, & nc_synchronize_file, & - NF90_MAX_NAME, NF90_MAX_VAR_DIMS + NF90_MAX_NAME, NF90_MAX_VAR_DIMS, NF90_FILL_REAL ! note here that you only need to distinguish between From e6e35ed091b8c33c44ad643c8a4128642940f347 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 30 Jan 2024 04:54:05 -0700 Subject: [PATCH 066/124] Removed test program transform_names from build list --- models/aether_lon-lat/work/quickbuild.sh | 1 - 1 file changed, 1 deletion(-) diff --git a/models/aether_lon-lat/work/quickbuild.sh b/models/aether_lon-lat/work/quickbuild.sh index 9008223e85..da16690f13 100755 --- a/models/aether_lon-lat/work/quickbuild.sh +++ b/models/aether_lon-lat/work/quickbuild.sh @@ -27,7 +27,6 @@ obs_seq_to_netcdf model_serial_programs=( aether_to_dart -transform_names dart_to_aether) arguments "$@" From 2e4b16dd5d847c793ab44692b39209300d0a8154 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 30 Jan 2024 09:58:29 -0700 Subject: [PATCH 067/124] Added a basic readme.rst and fixed a quickbuild bug --- models/aether_lon-lat/readme.rst | 766 +++++++++++++++++++++++ models/aether_lon-lat/work/quickbuild.sh | 2 +- 2 files changed, 767 insertions(+), 1 deletion(-) create mode 100644 models/aether_lon-lat/readme.rst diff --git a/models/aether_lon-lat/readme.rst b/models/aether_lon-lat/readme.rst new file mode 100644 index 0000000000..37352f2ed8 --- /dev/null +++ b/models/aether_lon-lat/readme.rst @@ -0,0 +1,766 @@ +Aether Rectangular Grid Interface +================================= + +Overview +-------- + +The Aether ("eether") space weather model (TODO: reference) can be implemented +on a logically rectangular grid"lon-lat", +or on an the cubed-sphere grid (see ../aether_cubed_shere). +This is the interface to the lon-lat version. + +Aether writes history and restart files, with some overlap of the fields (?). +The restart fields are divided among 2 types of files: neutrals and ions. +They are further divided into "blocks", which are subdomains of the globe. +All of these need to be combined to make a single state vector for filter. +There's a unique set of these files for each member. +The restart file names reflect this information: + {neutrals,ions}_mMMMM_gBBBB.nc + MMMM = ensemble member (0-based) + BBBB = block number (0-based) +These files do not have grid information in them, which must be read from + grid_gBBBB.nc + +Program aether_to_dart will read a selection of fields from all the restart +and grid files for a member and repackage them into an ensemble state vector +(filter_input.nc). + +Filter will read the ensemble of filter_input.nc files, assimilate, +and write an ensemble of filter_output.nc files. + +Program dart_to_aether will extract the updated field data from them +and overwrite those fields in the Aether restart files. + +Namelists +--------- + +- The namelists are 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. + +aether_to_dart_nml +..................... + +The Aether fields to be included in the model state are specified +in the ``variables`` namelist variable. +The following information must be provided for each field: + +1) Aether field name +# DART "quantity" to be associated with the field +# max value +# min value +# which file contains the field ("neutrals" or "ions") +# whether the field should be updated in the assimilation + +Aether field names are not CF-compliant and are translated +to CF-compliant forms by aether_to_dart. +The suggested DART quantity to associate with some fields are listed +in ./aether_to_dart.nml. + +The neutrals restart files contain the following fields. +The most important fields are **highlighted**.:: + **Temperature**, **velocity_east**, **velocity_north**, + velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 + +Similarly for the ions restart files: :: + **O+**, **O+_2D**, **O+_2P**, **O2+**, **N2+**, NO+, N+, He+, + Temperature_bulk_ion, Temperature_electron + **NOTE** As of this writing (2024-1-30) the electron density is not available + through the restart files, even though electron temperature is. + It can be written to the history files. + +In addition, there are 7 (independent) fields associated with *each* ion density: + +- Temperature\ \(O+\) +- velocity_parallel_east\ \(O+\) +- velocity_parallel_north\ \(O+\) +- velocity_parallel_up\ \(O+\) +- velocity_perp_east\ \(O+\) +- velocity_perp_north\ \(O+\) +- velocity_perp_up\ \(O+\) + + +dart_to_aether_nml +..................... + +The ``variables`` in this namelist must match the list in aether_to_dart_nml. +Dart_to_aether_nml will convert these fields names to the CF-compliant filter names, +find those names in filter_output.nc, and transfer the updated fields +from filter_output.nc to the Aether appropriate restart files. + + +model_nml +......... + +The fields listed in ``variables`` must be the translated names, +as found in the filter_input.nc files. +In general the transformation does the following: + +- Remove all '\', '(', and ')' +- Replace blanks with underscores +- Replace '+' with 'pos' and '-' with 'neg' +- For ions, move the ion name from the end to the beginning. + +For example 'velocity_parallel_east\ \(O+_2D\)' becomes +'Opos_2D_velocity_parallel_east' +:: + + &model_nml + / + +| + +Other modules used +------------------ + +:: + +default_model_mod +distributed_state_mod +ensemble_manager_mod +location_mod +netcdf_utilities_mod +obs_kind_mod +quad_utils_mod +state_structure_mod +types_mod +time_manager_mod +utilities_mod + +Public interfaces +----------------- + +======================= =================================== +*use model_mod, only :* get_model_size +\ adv_1step +\ get_state_meta_data +\ model_interpolate +\ shortest_time_between_assimilations +\ static_init_model +\ init_time +\ init_conditions +\ nc_write_model_atts +\ nc_write_model_vars +\ pert_model_copies +\ get_close_obs +\ get_close_state +\ convert_vertical_obs +\ convert_vertical_state +\ read_model_time +\ write_model_time +\ end_model +======================= =================================== + +A note about documentation style. Optional arguments are enclosed in brackets *[like this]*. + +| + +.. container:: routine + + *model_size = get_model_size( )* + :: + + integer(i8) :: get_model_size + +.. container:: indent1 + + Returns the length of the model state vector. Required. + + ============== ===================================== + ``model_size`` The length of the model state vector. + ============== ===================================== + +| + +.. container:: routine + + *call adv_1step(x, time)* + :: + + real(r8), dimension(:), intent(inout) :: x + type(time_type), intent(in) :: time + +.. container:: indent1 + + Does a single timestep advance of the model. The input value of the vector x is the starting condition and x must be + updated to reflect the changed state after a timestep. The time argument is intent in and is used for models that + need to know the date/time to compute a timestep, for instance for radiation computations. This interface is only + called if the namelist parameter async is set to 0 in ``perfect_model_obs`` or ``filter`` or if the program + ``integrate_model`` is to be used to advance the model state as a separate executable. If one of these options is not + going to be used (the model will *only* be advanced as a separate model-specific executable), this can be a NULL + INTERFACE. (The subroutine name must still exist, but it can contain no code and it will not be called.) + + ======== ================================== + ``x`` State vector of length model_size. + ``time`` Current time of the model state. + ======== ================================== + +| + +.. container:: routine + + *call get_state_meta_data (index_in, location, [, var_type] )* + :: + + integer, intent(in) :: index_in + type(location_type), intent(out) :: location + integer, optional, intent(out) :: var_type + +.. container:: indent1 + + Given an integer index into the state vector, returns the associated location. An optional argument returns the + generic quantity of this item, e.g. QTY_TEMPERATURE, QTY_DENSITY, QTY_SALINITY, QTY_U_WIND_COMPONENT. This interface + is required to be functional for all applications. + + ============ =================================================================== + ``index_in`` Index of state vector element about which information is requested. + ``location`` The location of state variable element. + *var_type* The generic quantity of the state variable element. + ============ =================================================================== + +| + +.. container:: routine + + *call model_interpolate(state_handle, ens_size, location, obs_quantity, expected_obs, istatus)* + :: + + type(ensemble_type), intent(in) :: state_handle + integer, intent(in) :: ens_size + type(location_type), intent(in) :: location + integer, intent(in) :: obs_quantity + real(r8), intent(out) :: expected_obs(ens_size) + integer, intent(out) :: istatus(ens_size) + +.. container:: indent1 + + Given a handle containing information for a state vector, an ensemble size, a location, and a model state variable + quantity interpolates the state variable field to that location and returns an ensemble-sized array of values in + ``expected_obs(:)``. The ``istatus(:)`` array should be 0 for successful ensemble members and a positive value for + failures. The ``obs_quantity`` variable is one of the quantity (QTY) parameters defined in the + :doc:`../../assimilation_code/modules/observations/obs_kind_mod` file and defines the quantity to interpolate. In + low-order models that have no notion of kinds of variables this argument may be ignored. For applications in which + only perfect model experiments with identity observations (i.e. only the value of a particular state variable is + observed), this can be a NULL INTERFACE. Otherwise it is required (which is the most common case). + + +------------------+--------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state structure containing information about the state vector about which | + | | information is requested. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``ens_size`` | The ensemble size. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``location`` | Location to which to interpolate. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``obs_quantity`` | Quantity of state field to be interpolated. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``expected_obs`` | The interpolated values from the model. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``istatus`` | Integer values return 0 for success. Other positive values can be defined for various failures. | + +------------------+--------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *var = shortest_time_between_assimilations()* + :: + + type(time_type) :: shortest_time_between_assimilations + +.. container:: indent1 + + Returns the smallest increment in time that the model is capable of advancing the state in a given implementation. + The actual value may be set by the model_mod namelist (depends on the model). This interface is required for all + applications. + + ======= =================================== + ``var`` Smallest advance time of the model. + ======= =================================== + +| + +.. container:: routine + + *call static_init_model()* + +.. container:: indent1 + + Called to do one time initialization of the model. As examples, might define information about the model size or + model timestep, read in grid information, read a namelist, set options, etc. In models that require pre-computed + static data, for instance spherical harmonic weights, these would also be computed here. Can be a NULL INTERFACE for + the simplest models. + +| + +.. container:: routine + + *call init_time(time)* + :: + + type(time_type), intent(out) :: time + +.. container:: indent1 + + Companion interface to init_conditions. Returns a time that is somehow appropriate for starting up a long integration + of the model. At present, this is only used if the ``perfect_model_obs`` namelist parameter + ``read_input_state_from_file = .false.`` If this option should not be used in ``perfect_model_obs``, calling this + routine should issue a fatal error. + + ======== =================== + ``time`` Initial model time. + ======== =================== + +| + +.. container:: routine + + *call init_conditions(x)* + :: + + real(r8), dimension(:), intent(out) :: x + +.. container:: indent1 + + Returns a model state vector, x, that is some sort of appropriate initial condition for starting up a long + integration of the model. At present, this is only used if the ``perfect_model_obs`` namelist parameter + ``read_input_state_from_file = .false.`` If this option should not be used in ``perfect_model_obs``, calling this + routine should issue a fatal error. + + ===== ==================================== + ``x`` Initial conditions for state vector. + ===== ==================================== + +| + +.. container:: routine + + *call nc_write_model_atts(ncFileID, domain_id)* + :: + + integer, intent(in) :: ncFileID + integer, intent(in) :: domain_id + +.. container:: indent1 + + | This routine writes the model-specific attributes to netCDF files that DART creates. This includes coordinate + variables and any metadata, but NOT the actual model state vector. ``models/template/model_mod.f90`` contains code + that can be used for any model as-is. + | The typical sequence for adding new dimensions, variables, attributes: + + :: + + NF90_OPEN ! open existing netCDF dataset + NF90_redef ! put into define mode + NF90_def_dim ! define additional dimensions (if any) + NF90_def_var ! define variables: from name, kind, and dims + NF90_put_att ! assign attribute values + NF90_ENDDEF ! end definitions: leave define mode + NF90_put_var ! provide values for variable + NF90_CLOSE ! close: save updated netCDF dataset + + +---------------+-----------------------------------------------------------------------------------------------------+ + | ``ncFileID`` | Integer file descriptor to previously-opened netCDF file. | + +---------------+-----------------------------------------------------------------------------------------------------+ + | ``domain_id`` | integer describing the domain (which can be a nesting level, a component model ...) Models with | + | | nested grids are decomposed into 'domains' in DART. The concept is extended to refer to 'coupled' | + | | models where one model component may be the atmosphere, another component may be the ocean, or | + | | land, or ionosphere ... these would be referenced as different domains. | + +---------------+-----------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call nc_write_model_vars(ncFileID, domain_id, state_ens_handle [, memberindex] [, timeindex])* + :: + + integer, intent(in) :: ncFileID + integer, intent(in) :: domain_id + type(ensemble_type), intent(in) :: state_ens_handle + integer, optional, intent(in) :: memberindex + integer, optional, intent(in) :: timeindex + +.. container:: indent1 + + | This routine may be used to write the model-specific state vector (data) to a netCDF file. Only used if + ``model_mod_writes_state_variables = .true.`` + | Typical sequence for adding new dimensions,variables,attributes: + + :: + + NF90_OPEN ! open existing netCDF dataset + NF90_redef ! put into define mode + NF90_def_dim ! define additional dimensions (if any) + NF90_def_var ! define variables: from name, kind, and dims + NF90_put_att ! assign attribute values + NF90_ENDDEF ! end definitions: leave define mode + NF90_put_var ! provide values for variable + NF90_CLOSE ! close: save updated netCDF dataset + + +----------------------+----------------------------------------------------------------------------------------------+ + | ``ncFileID`` | file descriptor to previously-opened netCDF file. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``domain_id`` | integer describing the domain (which can be a nesting level, a component model ...) | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``state_ens_handle`` | The handle to the state structure containing information about the state vector about which | + | | information is requested. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``memberindex`` | Integer index of ensemble member to be written. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``timeindex`` | The timestep counter for the given state. | + +----------------------+----------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call 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 + logical, intent(out) :: interf_provided + +.. container:: indent1 + + Given an ensemble handle, the ensemble size, and a perturbation amplitude; perturb the ensemble. Used to generate + initial conditions for spinning up ensembles. If the ``model_mod`` does not want to do this, instead allowing the + default algorithms in ``filter`` to take effect, ``interf_provided =&nbps;.false.`` and the routine can be trivial. + Otherwise, ``interf_provided`` must be returned as ``.true.`` + + +----------------------+----------------------------------------------------------------------------------------------+ + | ``state_ens_handle`` | The handle containing an ensemble of state vectors to be perturbed. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``ens_size`` | The number of ensemble members to perturb. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``pert_amp`` | the amplitude of the perturbations. The interpretation is based on the model-specific | + | | implementation. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``interf_provided`` | Returns false if model_mod cannot do this, else true. | + +----------------------+----------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, num_close, close_ind [, dist] [, + state_handle)* + :: + + type(get_close_type), intent(in) :: gc + type(location_type), intent(in) :: base_loc + integer, intent(in) :: base_type + type(location_type), intent(in) :: locs(:) + integer, intent(in) :: loc_qtys(:) + integer, intent(in) :: loc_types(:) + integer, intent(out) :: num_close + integer, intent(out) :: close_ind(:) + real(r8), optional, intent(out) :: dist(:) + type(ensemble_type), optional, intent(in) :: state_handle + +.. container:: indent1 + + | Given a location and quantity, compute the distances to all other locations in the ``obs`` list. The return values + are the number of items which are within maxdist of the base, the index numbers in the original obs list, and + optionally the distances. The ``gc`` contains precomputed information to speed the computations. + | In general this is a PASS-THROUGH ROUTINE. It is listed on the use line for the locations_mod, and in the public + list for this module, but has no subroutine declaration and no other code in this module: + + :: + + use location_mod, only: get_close_obs + + public :: get_close_obs + + However, if the model needs to alter the values or wants to supply an alternative implementation it can intercept the + call like so: + + :: + + use location_mod, only: & + lm_get_close_obs => get_close_obs + + public :: get_close_obs + + In this case a local ``get_close_obs()`` routine must be supplied. To call the original code in the location module + use: + + :: + + call lm_get_close_obs(gc, base_loc, ...) + + | This subroutine will be called after ``get_close_maxdist_init`` and ``get_close_obs_init``. + | In most cases the PASS-THROUGH ROUTINE will be used, but some models need to alter the actual distances depending + on the observation or state vector kind, or based on the observation or state vector location. It is reasonable in + this case to leave ``get_close_maxdist_init()`` and ``get_close_obs_init()`` as pass-through routines and intercept + only ``get_close_obs()``. The local ``get_close_obs()`` can first call the location mod routine and let it return a + list of values, and then inspect the list and alter or remove any entries as needed. See the CAM and WRF model_mod + files for examples of this use. + + +------------------+--------------------------------------------------------------------------------------------------+ + | ``gc`` | The get_close_type which stores precomputed information about the locations to speed up | + | | searching | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``base_loc`` | Reference location. The distances will be computed between this location and every other | + | | location in the obs list | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``base_type`` | The DART quantity at the ``base_loc`` | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``locs(:)`` | Compute the distance between the ``base_loc`` and each of the locations in this list | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_qtys(:)`` | The corresponding quantity of each item in the ``locs`` list | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_types(:)`` | The corresponding type of each item in the ``locs`` list. This is not available in the default | + | | implementation but may be used in custom implementations. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``num_close`` | The number of items from the ``locs`` list which are within maxdist of the base location | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``close_ind(:)`` | The list of index numbers from the ``locs`` list which are within maxdist of the base location | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``dist(:)`` | If present, return the distance between each entry in the close_ind list and the base location. | + | | If not present, all items in the obs list which are closer than maxdist will be added to the | + | | list but the overhead of computing the exact distances will be skipped. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state structure containing information about the state vector about which | + | | information is requested. | + +------------------+--------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call get_close_state(gc, base_loc, base_type, state_loc, state_qtys, state_indx, num_close, close_ind [, dist, + state_handle])* + :: + + type(get_close_type), intent(in) :: gc + type(location_type), intent(inout) :: base_loc + integer, intent(in) :: base_type + type(location_type), intent(inout) :: state_loc(:) + integer, intent(in) :: state_qtys(:) + integer(i8), intent(in) :: state_indx(:) + integer, intent(out) :: num_close + integer, intent(out) :: close_ind(:) + real(r8), optional, intent(out) :: dist(:) + type(ensemble_type), optional, intent(in) :: state_handle + +.. container:: indent1 + + | Given a location and quantity, compute the distances to all other locations in the ``state_loc`` list. The return + values are the number of items which are within maxdist of the base, the index numbers in the original state_loc + list, and optionally the distances. The ``gc`` contains precomputed information to speed the computations. + | In general this is a PASS-THROUGH ROUTINE. It is listed on the use line for the locations_mod, and in the public + list for this module, but has no subroutine declaration and no other code in this module: + + :: + + use location_mod, only: get_close_state + + public :: get_close_state + + However, if the model needs to alter the values or wants to supply an alternative implementation it can intercept the + call like so: + + :: + + use location_mod, only: & + lm_get_close_state => get_close_state + + public :: get_close_state + + In this case a local ``get_close_state()`` routine must be supplied. To call the original code in the location module + use: + + :: + + call loc_get_close_state(gc, base_loc, ...) + + | This subroutine will be called after ``get_close_maxdist_init`` and ``get_close_state_init``. + | In most cases the PASS-THROUGH ROUTINE will be used, but some models need to alter the actual distances depending + on the observation or state vector kind, or based on the observation or state vector location. It is reasonable in + this case to leave ``get_close_maxdist_init()`` and ``get_close_state_init()`` as pass-through routines and + intercept only ``get_close_state()``. The local ``get_close_state()`` can first call the location mod routine and + let it return a list of values, and then inspect the list and alter or remove any entries as needed. See the CAM + and WRF model_mod files for examples of this use. + + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``gc`` | The get_close_type which stores precomputed information about the locations to speed up | + | | searching | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``base_loc`` | Reference location. The distances will be computed between this location and every other | + | | location in the list | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``base_type`` | The DART quantity at the ``base_loc`` | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``state_loc(:)`` | Compute the distance between the ``base_loc`` and each of the locations in this list | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``state_qtys(:)`` | The corresponding quantity of each item in the ``state_loc`` list | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``state_indx(:)`` | The corresponding DART index of each item in the ``state_loc`` list. This is not available in | + | | the default implementation but may be used in custom implementations. | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``num_close`` | The number of items from the ``state_loc`` list which are within maxdist of the base location | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``close_ind(:)`` | The list of index numbers from the ``state_loc`` list which are within maxdist of the base | + | | location | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``dist(:)`` | If present, return the distance between each entry in the ``close_ind`` list and the base | + | | location. If not present, all items in the ``state_loc`` list which are closer than maxdist | + | | will be added to the list but the overhead of computing the exact distances will be skipped. | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state structure containing information about the state vector about which | + | | information is requested. | + +-------------------+-------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call 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(in) :: locs(:) + integer, intent(in) :: loc_qtys(:) + integer, intent(in) :: loc_types(:) + integer, intent(in) :: which_vert + integer, intent(out) :: status(:) + +.. container:: indent1 + + Converts the observations to the desired vertical localization coordinate system. Some models (toy models with no + 'real' observations) will not need this. Most (real) models have observations in one or more coordinate systems + (pressure, height) and the model is generally represented in only one coordinate system. To be able to interpolate + the model state to the observation location, or to compute the true distance between the state and the observation, + it is necessary to convert everything to a single coodinate system. + + +------------------+--------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``num`` | the number of observation locations | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``locs`` | the array of observation locations | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_qtys`` | the array of observation quantities. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_types`` | the array of observation types. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``which_vert`` | the desired vertical coordinate system. There is a table in the ``location_mod.f90`` that | + | | relates integers to vertical coordinate systems. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``status`` | Success or failure of the vertical conversion. If ``istatus = 0``, the conversion was a success. | + | | Any other value is a failure. | + +------------------+--------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call convert_vertical_state(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(in) :: locs(:) + integer, intent(in) :: loc_qtys(:) + integer(i8), intent(in) :: loc_indx(:) + integer, intent(in) :: which_vert + integer, intent(out) :: status(:) + +.. container:: indent1 + + Converts the state to the desired vertical localization coordinate system. Some models (toy models with no 'real' + observations) will not need this. To compute the true distance between the state and the observation, it is necessary + to convert everything to a single coodinate system. + + +------------------+--------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``num`` | the number of state locations | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``locs`` | the array of state locations | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_qtys`` | the array of state quantities. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_indx`` | the array of state indices. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``which_vert`` | the desired vertical coordinate system. There is a table in the ``location_mod.f90`` that | + | | relates integers to vertical coordinate systems. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``status`` | Success or failure of the vertical conversion. If ``istatus = 0``, the conversion was a success. | + | | Any other value is a failure. | + +------------------+--------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *model_time = read_model_time(filename)* + :: + + character(len=*), intent(in) :: filename + type(time_type) :: model_time + +.. container:: indent1 + + Reads the valid time of the model state in a netCDF file. There is a default routine in + ``assimilation_code/modules/io/dart_time_io_mod.f90`` that can be used as a pass-through. That routine will read the + **last** timestep of a 'time' variable - which is the same strategy used for reading netCDF files that have multiple + timesteps in them. If your model has some other representation of time (i.e. it does not use a netCDF variable named + 'time') - you will have to write this routine. + + ============= ==================================== + ``ncid`` handle to an open netCDF file + ``dart_time`` The current time of the model state. + ============= ==================================== + +| + +.. container:: routine + + *call write_model_time(ncid, dart_time)* + :: + + integer, intent(in) :: ncid + type(time_type), intent(in) :: dart_time + +.. container:: indent1 + + Writes the assimilation time to a netCDF file. There is a default routine in + ``assimilation_code/modules/io/dart_time_io_mod.f90`` that can be used as a pass-through. If your model has some + other representation of time (i.e. it does not use a netCDF variable named 'time') - you will have to write this + routine. + + ============= ==================================== + ``ncid`` handle to an open netCDF file + ``dart_time`` The current time of the model state. + ============= ==================================== + +| + +.. container:: routine + + *call end_model()* + +.. container:: indent1 + + Does any shutdown and clean-up needed for model. Can be a NULL INTERFACE if the model has no need to clean up + storage, etc. + +Files +----- + +- Models are free to read and write files as they see fit. + +References +---------- + +#. none + +Private components +------------------ + +N/A diff --git a/models/aether_lon-lat/work/quickbuild.sh b/models/aether_lon-lat/work/quickbuild.sh index 9008223e85..4b90675177 100755 --- a/models/aether_lon-lat/work/quickbuild.sh +++ b/models/aether_lon-lat/work/quickbuild.sh @@ -27,8 +27,8 @@ obs_seq_to_netcdf model_serial_programs=( aether_to_dart -transform_names dart_to_aether) +# transform_names arguments "$@" From c841e47898342e97d0c6fce091567a399b06025c Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 30 Jan 2024 10:30:19 -0700 Subject: [PATCH 068/124] Added a basic readme.rst --- models/aether_lon-lat/readme.rst | 766 +++++++++++++++++++++++++++++++ 1 file changed, 766 insertions(+) create mode 100644 models/aether_lon-lat/readme.rst diff --git a/models/aether_lon-lat/readme.rst b/models/aether_lon-lat/readme.rst new file mode 100644 index 0000000000..37352f2ed8 --- /dev/null +++ b/models/aether_lon-lat/readme.rst @@ -0,0 +1,766 @@ +Aether Rectangular Grid Interface +================================= + +Overview +-------- + +The Aether ("eether") space weather model (TODO: reference) can be implemented +on a logically rectangular grid"lon-lat", +or on an the cubed-sphere grid (see ../aether_cubed_shere). +This is the interface to the lon-lat version. + +Aether writes history and restart files, with some overlap of the fields (?). +The restart fields are divided among 2 types of files: neutrals and ions. +They are further divided into "blocks", which are subdomains of the globe. +All of these need to be combined to make a single state vector for filter. +There's a unique set of these files for each member. +The restart file names reflect this information: + {neutrals,ions}_mMMMM_gBBBB.nc + MMMM = ensemble member (0-based) + BBBB = block number (0-based) +These files do not have grid information in them, which must be read from + grid_gBBBB.nc + +Program aether_to_dart will read a selection of fields from all the restart +and grid files for a member and repackage them into an ensemble state vector +(filter_input.nc). + +Filter will read the ensemble of filter_input.nc files, assimilate, +and write an ensemble of filter_output.nc files. + +Program dart_to_aether will extract the updated field data from them +and overwrite those fields in the Aether restart files. + +Namelists +--------- + +- The namelists are 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. + +aether_to_dart_nml +..................... + +The Aether fields to be included in the model state are specified +in the ``variables`` namelist variable. +The following information must be provided for each field: + +1) Aether field name +# DART "quantity" to be associated with the field +# max value +# min value +# which file contains the field ("neutrals" or "ions") +# whether the field should be updated in the assimilation + +Aether field names are not CF-compliant and are translated +to CF-compliant forms by aether_to_dart. +The suggested DART quantity to associate with some fields are listed +in ./aether_to_dart.nml. + +The neutrals restart files contain the following fields. +The most important fields are **highlighted**.:: + **Temperature**, **velocity_east**, **velocity_north**, + velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 + +Similarly for the ions restart files: :: + **O+**, **O+_2D**, **O+_2P**, **O2+**, **N2+**, NO+, N+, He+, + Temperature_bulk_ion, Temperature_electron + **NOTE** As of this writing (2024-1-30) the electron density is not available + through the restart files, even though electron temperature is. + It can be written to the history files. + +In addition, there are 7 (independent) fields associated with *each* ion density: + +- Temperature\ \(O+\) +- velocity_parallel_east\ \(O+\) +- velocity_parallel_north\ \(O+\) +- velocity_parallel_up\ \(O+\) +- velocity_perp_east\ \(O+\) +- velocity_perp_north\ \(O+\) +- velocity_perp_up\ \(O+\) + + +dart_to_aether_nml +..................... + +The ``variables`` in this namelist must match the list in aether_to_dart_nml. +Dart_to_aether_nml will convert these fields names to the CF-compliant filter names, +find those names in filter_output.nc, and transfer the updated fields +from filter_output.nc to the Aether appropriate restart files. + + +model_nml +......... + +The fields listed in ``variables`` must be the translated names, +as found in the filter_input.nc files. +In general the transformation does the following: + +- Remove all '\', '(', and ')' +- Replace blanks with underscores +- Replace '+' with 'pos' and '-' with 'neg' +- For ions, move the ion name from the end to the beginning. + +For example 'velocity_parallel_east\ \(O+_2D\)' becomes +'Opos_2D_velocity_parallel_east' +:: + + &model_nml + / + +| + +Other modules used +------------------ + +:: + +default_model_mod +distributed_state_mod +ensemble_manager_mod +location_mod +netcdf_utilities_mod +obs_kind_mod +quad_utils_mod +state_structure_mod +types_mod +time_manager_mod +utilities_mod + +Public interfaces +----------------- + +======================= =================================== +*use model_mod, only :* get_model_size +\ adv_1step +\ get_state_meta_data +\ model_interpolate +\ shortest_time_between_assimilations +\ static_init_model +\ init_time +\ init_conditions +\ nc_write_model_atts +\ nc_write_model_vars +\ pert_model_copies +\ get_close_obs +\ get_close_state +\ convert_vertical_obs +\ convert_vertical_state +\ read_model_time +\ write_model_time +\ end_model +======================= =================================== + +A note about documentation style. Optional arguments are enclosed in brackets *[like this]*. + +| + +.. container:: routine + + *model_size = get_model_size( )* + :: + + integer(i8) :: get_model_size + +.. container:: indent1 + + Returns the length of the model state vector. Required. + + ============== ===================================== + ``model_size`` The length of the model state vector. + ============== ===================================== + +| + +.. container:: routine + + *call adv_1step(x, time)* + :: + + real(r8), dimension(:), intent(inout) :: x + type(time_type), intent(in) :: time + +.. container:: indent1 + + Does a single timestep advance of the model. The input value of the vector x is the starting condition and x must be + updated to reflect the changed state after a timestep. The time argument is intent in and is used for models that + need to know the date/time to compute a timestep, for instance for radiation computations. This interface is only + called if the namelist parameter async is set to 0 in ``perfect_model_obs`` or ``filter`` or if the program + ``integrate_model`` is to be used to advance the model state as a separate executable. If one of these options is not + going to be used (the model will *only* be advanced as a separate model-specific executable), this can be a NULL + INTERFACE. (The subroutine name must still exist, but it can contain no code and it will not be called.) + + ======== ================================== + ``x`` State vector of length model_size. + ``time`` Current time of the model state. + ======== ================================== + +| + +.. container:: routine + + *call get_state_meta_data (index_in, location, [, var_type] )* + :: + + integer, intent(in) :: index_in + type(location_type), intent(out) :: location + integer, optional, intent(out) :: var_type + +.. container:: indent1 + + Given an integer index into the state vector, returns the associated location. An optional argument returns the + generic quantity of this item, e.g. QTY_TEMPERATURE, QTY_DENSITY, QTY_SALINITY, QTY_U_WIND_COMPONENT. This interface + is required to be functional for all applications. + + ============ =================================================================== + ``index_in`` Index of state vector element about which information is requested. + ``location`` The location of state variable element. + *var_type* The generic quantity of the state variable element. + ============ =================================================================== + +| + +.. container:: routine + + *call model_interpolate(state_handle, ens_size, location, obs_quantity, expected_obs, istatus)* + :: + + type(ensemble_type), intent(in) :: state_handle + integer, intent(in) :: ens_size + type(location_type), intent(in) :: location + integer, intent(in) :: obs_quantity + real(r8), intent(out) :: expected_obs(ens_size) + integer, intent(out) :: istatus(ens_size) + +.. container:: indent1 + + Given a handle containing information for a state vector, an ensemble size, a location, and a model state variable + quantity interpolates the state variable field to that location and returns an ensemble-sized array of values in + ``expected_obs(:)``. The ``istatus(:)`` array should be 0 for successful ensemble members and a positive value for + failures. The ``obs_quantity`` variable is one of the quantity (QTY) parameters defined in the + :doc:`../../assimilation_code/modules/observations/obs_kind_mod` file and defines the quantity to interpolate. In + low-order models that have no notion of kinds of variables this argument may be ignored. For applications in which + only perfect model experiments with identity observations (i.e. only the value of a particular state variable is + observed), this can be a NULL INTERFACE. Otherwise it is required (which is the most common case). + + +------------------+--------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state structure containing information about the state vector about which | + | | information is requested. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``ens_size`` | The ensemble size. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``location`` | Location to which to interpolate. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``obs_quantity`` | Quantity of state field to be interpolated. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``expected_obs`` | The interpolated values from the model. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``istatus`` | Integer values return 0 for success. Other positive values can be defined for various failures. | + +------------------+--------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *var = shortest_time_between_assimilations()* + :: + + type(time_type) :: shortest_time_between_assimilations + +.. container:: indent1 + + Returns the smallest increment in time that the model is capable of advancing the state in a given implementation. + The actual value may be set by the model_mod namelist (depends on the model). This interface is required for all + applications. + + ======= =================================== + ``var`` Smallest advance time of the model. + ======= =================================== + +| + +.. container:: routine + + *call static_init_model()* + +.. container:: indent1 + + Called to do one time initialization of the model. As examples, might define information about the model size or + model timestep, read in grid information, read a namelist, set options, etc. In models that require pre-computed + static data, for instance spherical harmonic weights, these would also be computed here. Can be a NULL INTERFACE for + the simplest models. + +| + +.. container:: routine + + *call init_time(time)* + :: + + type(time_type), intent(out) :: time + +.. container:: indent1 + + Companion interface to init_conditions. Returns a time that is somehow appropriate for starting up a long integration + of the model. At present, this is only used if the ``perfect_model_obs`` namelist parameter + ``read_input_state_from_file = .false.`` If this option should not be used in ``perfect_model_obs``, calling this + routine should issue a fatal error. + + ======== =================== + ``time`` Initial model time. + ======== =================== + +| + +.. container:: routine + + *call init_conditions(x)* + :: + + real(r8), dimension(:), intent(out) :: x + +.. container:: indent1 + + Returns a model state vector, x, that is some sort of appropriate initial condition for starting up a long + integration of the model. At present, this is only used if the ``perfect_model_obs`` namelist parameter + ``read_input_state_from_file = .false.`` If this option should not be used in ``perfect_model_obs``, calling this + routine should issue a fatal error. + + ===== ==================================== + ``x`` Initial conditions for state vector. + ===== ==================================== + +| + +.. container:: routine + + *call nc_write_model_atts(ncFileID, domain_id)* + :: + + integer, intent(in) :: ncFileID + integer, intent(in) :: domain_id + +.. container:: indent1 + + | This routine writes the model-specific attributes to netCDF files that DART creates. This includes coordinate + variables and any metadata, but NOT the actual model state vector. ``models/template/model_mod.f90`` contains code + that can be used for any model as-is. + | The typical sequence for adding new dimensions, variables, attributes: + + :: + + NF90_OPEN ! open existing netCDF dataset + NF90_redef ! put into define mode + NF90_def_dim ! define additional dimensions (if any) + NF90_def_var ! define variables: from name, kind, and dims + NF90_put_att ! assign attribute values + NF90_ENDDEF ! end definitions: leave define mode + NF90_put_var ! provide values for variable + NF90_CLOSE ! close: save updated netCDF dataset + + +---------------+-----------------------------------------------------------------------------------------------------+ + | ``ncFileID`` | Integer file descriptor to previously-opened netCDF file. | + +---------------+-----------------------------------------------------------------------------------------------------+ + | ``domain_id`` | integer describing the domain (which can be a nesting level, a component model ...) Models with | + | | nested grids are decomposed into 'domains' in DART. The concept is extended to refer to 'coupled' | + | | models where one model component may be the atmosphere, another component may be the ocean, or | + | | land, or ionosphere ... these would be referenced as different domains. | + +---------------+-----------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call nc_write_model_vars(ncFileID, domain_id, state_ens_handle [, memberindex] [, timeindex])* + :: + + integer, intent(in) :: ncFileID + integer, intent(in) :: domain_id + type(ensemble_type), intent(in) :: state_ens_handle + integer, optional, intent(in) :: memberindex + integer, optional, intent(in) :: timeindex + +.. container:: indent1 + + | This routine may be used to write the model-specific state vector (data) to a netCDF file. Only used if + ``model_mod_writes_state_variables = .true.`` + | Typical sequence for adding new dimensions,variables,attributes: + + :: + + NF90_OPEN ! open existing netCDF dataset + NF90_redef ! put into define mode + NF90_def_dim ! define additional dimensions (if any) + NF90_def_var ! define variables: from name, kind, and dims + NF90_put_att ! assign attribute values + NF90_ENDDEF ! end definitions: leave define mode + NF90_put_var ! provide values for variable + NF90_CLOSE ! close: save updated netCDF dataset + + +----------------------+----------------------------------------------------------------------------------------------+ + | ``ncFileID`` | file descriptor to previously-opened netCDF file. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``domain_id`` | integer describing the domain (which can be a nesting level, a component model ...) | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``state_ens_handle`` | The handle to the state structure containing information about the state vector about which | + | | information is requested. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``memberindex`` | Integer index of ensemble member to be written. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``timeindex`` | The timestep counter for the given state. | + +----------------------+----------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call 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 + logical, intent(out) :: interf_provided + +.. container:: indent1 + + Given an ensemble handle, the ensemble size, and a perturbation amplitude; perturb the ensemble. Used to generate + initial conditions for spinning up ensembles. If the ``model_mod`` does not want to do this, instead allowing the + default algorithms in ``filter`` to take effect, ``interf_provided =&nbps;.false.`` and the routine can be trivial. + Otherwise, ``interf_provided`` must be returned as ``.true.`` + + +----------------------+----------------------------------------------------------------------------------------------+ + | ``state_ens_handle`` | The handle containing an ensemble of state vectors to be perturbed. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``ens_size`` | The number of ensemble members to perturb. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``pert_amp`` | the amplitude of the perturbations. The interpretation is based on the model-specific | + | | implementation. | + +----------------------+----------------------------------------------------------------------------------------------+ + | ``interf_provided`` | Returns false if model_mod cannot do this, else true. | + +----------------------+----------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, num_close, close_ind [, dist] [, + state_handle)* + :: + + type(get_close_type), intent(in) :: gc + type(location_type), intent(in) :: base_loc + integer, intent(in) :: base_type + type(location_type), intent(in) :: locs(:) + integer, intent(in) :: loc_qtys(:) + integer, intent(in) :: loc_types(:) + integer, intent(out) :: num_close + integer, intent(out) :: close_ind(:) + real(r8), optional, intent(out) :: dist(:) + type(ensemble_type), optional, intent(in) :: state_handle + +.. container:: indent1 + + | Given a location and quantity, compute the distances to all other locations in the ``obs`` list. The return values + are the number of items which are within maxdist of the base, the index numbers in the original obs list, and + optionally the distances. The ``gc`` contains precomputed information to speed the computations. + | In general this is a PASS-THROUGH ROUTINE. It is listed on the use line for the locations_mod, and in the public + list for this module, but has no subroutine declaration and no other code in this module: + + :: + + use location_mod, only: get_close_obs + + public :: get_close_obs + + However, if the model needs to alter the values or wants to supply an alternative implementation it can intercept the + call like so: + + :: + + use location_mod, only: & + lm_get_close_obs => get_close_obs + + public :: get_close_obs + + In this case a local ``get_close_obs()`` routine must be supplied. To call the original code in the location module + use: + + :: + + call lm_get_close_obs(gc, base_loc, ...) + + | This subroutine will be called after ``get_close_maxdist_init`` and ``get_close_obs_init``. + | In most cases the PASS-THROUGH ROUTINE will be used, but some models need to alter the actual distances depending + on the observation or state vector kind, or based on the observation or state vector location. It is reasonable in + this case to leave ``get_close_maxdist_init()`` and ``get_close_obs_init()`` as pass-through routines and intercept + only ``get_close_obs()``. The local ``get_close_obs()`` can first call the location mod routine and let it return a + list of values, and then inspect the list and alter or remove any entries as needed. See the CAM and WRF model_mod + files for examples of this use. + + +------------------+--------------------------------------------------------------------------------------------------+ + | ``gc`` | The get_close_type which stores precomputed information about the locations to speed up | + | | searching | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``base_loc`` | Reference location. The distances will be computed between this location and every other | + | | location in the obs list | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``base_type`` | The DART quantity at the ``base_loc`` | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``locs(:)`` | Compute the distance between the ``base_loc`` and each of the locations in this list | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_qtys(:)`` | The corresponding quantity of each item in the ``locs`` list | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_types(:)`` | The corresponding type of each item in the ``locs`` list. This is not available in the default | + | | implementation but may be used in custom implementations. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``num_close`` | The number of items from the ``locs`` list which are within maxdist of the base location | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``close_ind(:)`` | The list of index numbers from the ``locs`` list which are within maxdist of the base location | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``dist(:)`` | If present, return the distance between each entry in the close_ind list and the base location. | + | | If not present, all items in the obs list which are closer than maxdist will be added to the | + | | list but the overhead of computing the exact distances will be skipped. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state structure containing information about the state vector about which | + | | information is requested. | + +------------------+--------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call get_close_state(gc, base_loc, base_type, state_loc, state_qtys, state_indx, num_close, close_ind [, dist, + state_handle])* + :: + + type(get_close_type), intent(in) :: gc + type(location_type), intent(inout) :: base_loc + integer, intent(in) :: base_type + type(location_type), intent(inout) :: state_loc(:) + integer, intent(in) :: state_qtys(:) + integer(i8), intent(in) :: state_indx(:) + integer, intent(out) :: num_close + integer, intent(out) :: close_ind(:) + real(r8), optional, intent(out) :: dist(:) + type(ensemble_type), optional, intent(in) :: state_handle + +.. container:: indent1 + + | Given a location and quantity, compute the distances to all other locations in the ``state_loc`` list. The return + values are the number of items which are within maxdist of the base, the index numbers in the original state_loc + list, and optionally the distances. The ``gc`` contains precomputed information to speed the computations. + | In general this is a PASS-THROUGH ROUTINE. It is listed on the use line for the locations_mod, and in the public + list for this module, but has no subroutine declaration and no other code in this module: + + :: + + use location_mod, only: get_close_state + + public :: get_close_state + + However, if the model needs to alter the values or wants to supply an alternative implementation it can intercept the + call like so: + + :: + + use location_mod, only: & + lm_get_close_state => get_close_state + + public :: get_close_state + + In this case a local ``get_close_state()`` routine must be supplied. To call the original code in the location module + use: + + :: + + call loc_get_close_state(gc, base_loc, ...) + + | This subroutine will be called after ``get_close_maxdist_init`` and ``get_close_state_init``. + | In most cases the PASS-THROUGH ROUTINE will be used, but some models need to alter the actual distances depending + on the observation or state vector kind, or based on the observation or state vector location. It is reasonable in + this case to leave ``get_close_maxdist_init()`` and ``get_close_state_init()`` as pass-through routines and + intercept only ``get_close_state()``. The local ``get_close_state()`` can first call the location mod routine and + let it return a list of values, and then inspect the list and alter or remove any entries as needed. See the CAM + and WRF model_mod files for examples of this use. + + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``gc`` | The get_close_type which stores precomputed information about the locations to speed up | + | | searching | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``base_loc`` | Reference location. The distances will be computed between this location and every other | + | | location in the list | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``base_type`` | The DART quantity at the ``base_loc`` | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``state_loc(:)`` | Compute the distance between the ``base_loc`` and each of the locations in this list | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``state_qtys(:)`` | The corresponding quantity of each item in the ``state_loc`` list | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``state_indx(:)`` | The corresponding DART index of each item in the ``state_loc`` list. This is not available in | + | | the default implementation but may be used in custom implementations. | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``num_close`` | The number of items from the ``state_loc`` list which are within maxdist of the base location | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``close_ind(:)`` | The list of index numbers from the ``state_loc`` list which are within maxdist of the base | + | | location | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``dist(:)`` | If present, return the distance between each entry in the ``close_ind`` list and the base | + | | location. If not present, all items in the ``state_loc`` list which are closer than maxdist | + | | will be added to the list but the overhead of computing the exact distances will be skipped. | + +-------------------+-------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state structure containing information about the state vector about which | + | | information is requested. | + +-------------------+-------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call 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(in) :: locs(:) + integer, intent(in) :: loc_qtys(:) + integer, intent(in) :: loc_types(:) + integer, intent(in) :: which_vert + integer, intent(out) :: status(:) + +.. container:: indent1 + + Converts the observations to the desired vertical localization coordinate system. Some models (toy models with no + 'real' observations) will not need this. Most (real) models have observations in one or more coordinate systems + (pressure, height) and the model is generally represented in only one coordinate system. To be able to interpolate + the model state to the observation location, or to compute the true distance between the state and the observation, + it is necessary to convert everything to a single coodinate system. + + +------------------+--------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``num`` | the number of observation locations | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``locs`` | the array of observation locations | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_qtys`` | the array of observation quantities. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_types`` | the array of observation types. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``which_vert`` | the desired vertical coordinate system. There is a table in the ``location_mod.f90`` that | + | | relates integers to vertical coordinate systems. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``status`` | Success or failure of the vertical conversion. If ``istatus = 0``, the conversion was a success. | + | | Any other value is a failure. | + +------------------+--------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *call convert_vertical_state(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(in) :: locs(:) + integer, intent(in) :: loc_qtys(:) + integer(i8), intent(in) :: loc_indx(:) + integer, intent(in) :: which_vert + integer, intent(out) :: status(:) + +.. container:: indent1 + + Converts the state to the desired vertical localization coordinate system. Some models (toy models with no 'real' + observations) will not need this. To compute the true distance between the state and the observation, it is necessary + to convert everything to a single coodinate system. + + +------------------+--------------------------------------------------------------------------------------------------+ + | ``state_handle`` | The handle to the state. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``num`` | the number of state locations | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``locs`` | the array of state locations | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_qtys`` | the array of state quantities. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``loc_indx`` | the array of state indices. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``which_vert`` | the desired vertical coordinate system. There is a table in the ``location_mod.f90`` that | + | | relates integers to vertical coordinate systems. | + +------------------+--------------------------------------------------------------------------------------------------+ + | ``status`` | Success or failure of the vertical conversion. If ``istatus = 0``, the conversion was a success. | + | | Any other value is a failure. | + +------------------+--------------------------------------------------------------------------------------------------+ + +| + +.. container:: routine + + *model_time = read_model_time(filename)* + :: + + character(len=*), intent(in) :: filename + type(time_type) :: model_time + +.. container:: indent1 + + Reads the valid time of the model state in a netCDF file. There is a default routine in + ``assimilation_code/modules/io/dart_time_io_mod.f90`` that can be used as a pass-through. That routine will read the + **last** timestep of a 'time' variable - which is the same strategy used for reading netCDF files that have multiple + timesteps in them. If your model has some other representation of time (i.e. it does not use a netCDF variable named + 'time') - you will have to write this routine. + + ============= ==================================== + ``ncid`` handle to an open netCDF file + ``dart_time`` The current time of the model state. + ============= ==================================== + +| + +.. container:: routine + + *call write_model_time(ncid, dart_time)* + :: + + integer, intent(in) :: ncid + type(time_type), intent(in) :: dart_time + +.. container:: indent1 + + Writes the assimilation time to a netCDF file. There is a default routine in + ``assimilation_code/modules/io/dart_time_io_mod.f90`` that can be used as a pass-through. If your model has some + other representation of time (i.e. it does not use a netCDF variable named 'time') - you will have to write this + routine. + + ============= ==================================== + ``ncid`` handle to an open netCDF file + ``dart_time`` The current time of the model state. + ============= ==================================== + +| + +.. container:: routine + + *call end_model()* + +.. container:: indent1 + + Does any shutdown and clean-up needed for model. Can be a NULL INTERFACE if the model has no need to clean up + storage, etc. + +Files +----- + +- Models are free to read and write files as they see fit. + +References +---------- + +#. none + +Private components +------------------ + +N/A From d47899cd4f7c41a1f32de1406e5c54585ab915ba Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 30 Jan 2024 13:05:09 -0700 Subject: [PATCH 069/124] rst docs for aether --- index.rst | 1 + models/aether_lon-lat/aether_to_dart.rst | 149 --------------------- models/aether_lon-lat/dart_to_aether.rst | 161 ----------------------- 3 files changed, 1 insertion(+), 310 deletions(-) delete mode 100644 models/aether_lon-lat/aether_to_dart.rst delete mode 100644 models/aether_lon-lat/dart_to_aether.rst diff --git a/index.rst b/index.rst index 3edd869bb6..038d45a345 100644 --- a/index.rst +++ b/index.rst @@ -371,6 +371,7 @@ References :hidden: models/9var/readme + models/aether/readme models/am2/readme models/bgrid_solo/readme models/cam-fv/readme diff --git a/models/aether_lon-lat/aether_to_dart.rst b/models/aether_lon-lat/aether_to_dart.rst deleted file mode 100644 index 33eb3db29d..0000000000 --- a/models/aether_lon-lat/aether_to_dart.rst +++ /dev/null @@ -1,149 +0,0 @@ -gitm_blocks_to_netcdf`` -================================= - -.. attention:: - - ``GITM`` works with versions of DART *before* Manhattan (9.x.x) and has yet to be updated. If you are interested in - using ``GITM`` with more recent versions of DART, contact DAReS staff to assess the feasibility of an update. - Until that time, you should consider this documentation as out-of-date. - - -| The `Global Ionosphere Thermosphere Model (GITM) `__ is a - 3-dimensional spherical code that models the Earth's thermosphere and ionosphere system using a stretched grid in - latitude and altitude. For a fuller description of using GITM within DART, please see the :doc:`./readme` documentation. -| ``gitm_blocks_to_netcdf`` is the program that reads GITM restart files (i.e. ``b?????.rst``) and creates a DART - output/restart file (e.g. ``perfect_ics, filter_ics, ...``). -| The list of variables used to create the DART state vector are specified in the ``input.nml`` file. -| Conditions required for successful execution of ``gitm_blocks_to_netcdf``: - -- a valid ``input.nml`` namelist file for DART -- a valid ``UAM.in`` control file for GITM -- a set of ``b?????.rst`` data files for GITM -- a ``header.rst`` file for GITM -- the DART/GITM interfaces must be compiled in a manner consistent with the GITM data and control files. The following - GITM source files are required to build *any* DART interface: - - - models/gitm/GITM2/src/ModConstants.f90 - - models/gitm/GITM2/src/ModEarth.f90 - - models/gitm/GITM2/src/ModKind.f90 - - models/gitm/GITM2/src/ModOrbital.f90 - - models/gitm/GITM2/src/ModSize.f90 - - models/gitm/GITM2/src/ModTime.f90 - - models/gitm/GITM2/src/time_routines.f90 - - Versions of these are included in the DART release. ``ModSize.f90``, in particular, must match what was used to - create the ``b????.rst`` files. - -The individual model instances are run in unique directories. This is also where the converter routines -``gitm_blocks_to_netcdf`` and ``dart_to_gitm`` are run. This makes it easy to use a single 'static' name for the input -and output filenames. ``advance_model.csh`` is responsibile for linking the appropriate files to these static filenames. - -The simplest way to test the converter is to compile GITM and run a single model state forward using ``work/clean.sh``. -To build GITM ... download GITM and unpack the code into ``DART/models/gitm/GITM2`` and follow these instructions: - -.. container:: unix - - :: - - cd models/gitm/GITM2 - ./Config.pl -install -compiler=ifortmpif90 -earth - make - cd ../work - ./clean.sh 1 1 0 150.0 170.0 1.0 - -Namelist --------- - -We adhere to the F90 standard of starting a namelist with an ampersand '&' and terminating with a slash '/' for all our -namelist input. Character strings that contain a '/' must be enclosed in quotes to prevent them from prematurely -terminating the namelist. - -:: - - &gitm_blocks_to_netcdf_nml - gitm_blocks_to_netcdf_output_file = 'dart_ics', - / - - &model_nml - gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', - assimilation_period_days = 0, - assimilation_period_seconds = 1800, - model_perturbation_amplitude = 0.2, - output_state_vector = .false., - calendar = 'Gregorian', - debug = 0, - gitm_state_variables = 'Temperature', 'QTY_TEMPERATURE', - 'eTemperature', 'QTY_TEMPERATURE_ELECTRON', - 'ITemperature', 'QTY_TEMPERATURE_ION', - 'iO_3P_NDensityS', 'QTY_DENSITY_NEUTRAL_O3P', - ... - -+-----------------------------------+--------------------+-----------------------------------------------------------+ -| Contents | Type | Description | -+===================================+====================+===========================================================+ -| gitm_blocks_to_netcdf_output_file | character(len=128) | The name of the DART file containing the model state | -| | | derived from the GITM restart files. | -+-----------------------------------+--------------------+-----------------------------------------------------------+ - -| - -The full description of the ``model_nml`` namelist is documented in the `gitm model_mod `__, -but the most important variable for ``gitm_blocks_to_netcdf`` is repeated here. - -+---------------------------------------+---------------------------------------+---------------------------------------+ -| Contents | Type | Description | -+=======================================+=======================================+=======================================+ -| gitm_restart_dirname | character(len=256) | The name of the directory containing | -| | | the GITM restart files and runtime | -| | | control information. | -+---------------------------------------+---------------------------------------+---------------------------------------+ -| gitm_state_variables | character(len=32), | The list of variable names in the | -| | dimension(2,80) | gitm restart file to use to create | -| | | the DART state vector and their | -| | | corresponding DART kind. The default | -| | | list is specified in | -| | | model_mod.nml | -+---------------------------------------+---------------------------------------+---------------------------------------+ - -Modules used ------------- - -:: - - obs_def_upper_atm_mod.f90 - assim_model_mod.f90 - types_mod.f90 - location/threed_sphere/location_mod.f90 - models/gitm/GITM2/src/ModConstants.f90 - models/gitm/GITM2/src/ModEarth.f90 - models/gitm/GITM2/src/ModKind.f90 - models/gitm/GITM2/src/ModSize.f90 - models/gitm/GITM2/src/ModTime.f90 - models/gitm/GITM2/src/time_routines.f90 - models/gitm/dart_gitm_mod.f90 - models/gitm/gitm_blocks_to_netcdf.f90 - models/gitm/model_mod.f90 - null_mpi_utilities_mod.f90 - obs_kind_mod.f90 - random_seq_mod.f90 - time_manager_mod.f90 - utilities_mod.f90 - -Files read ----------- - -- gitm restart files: ``b????.rst`` -- gitm control files: ``header.rst`` -- gitm control files: ``UAM.in.rst`` -- DART namelist file: ``input.nml`` - -Files written -------------- - -- DART initial conditions/restart file; e.g. ``dart_ics`` - -References ----------- - -- The official ``GITM`` site is: can be found at - `ccmc.gsfc.nasa.gov/models/modelinfo.php?model=GITM `__ diff --git a/models/aether_lon-lat/dart_to_aether.rst b/models/aether_lon-lat/dart_to_aether.rst deleted file mode 100644 index a65d7b3e11..0000000000 --- a/models/aether_lon-lat/dart_to_aether.rst +++ /dev/null @@ -1,161 +0,0 @@ -PROGRAM ``netcdf_to_gitm_blocks`` -================================= - -.. attention:: - - ``GITM`` works with versions of DART *before* Manhattan (9.x.x) and has yet to be updated. If you are interested in - using ``GITM`` with more recent versions of DART, contact DAReS staff to assess the feasibility of an update. - Until that time, you should consider this documentation as out-of-date. - - -| The `Global Ionosphere Thermosphere Model (GITM) `__ is a - 3-dimensional spherical code that models the Earth's thermosphere and ionosphere system using a stretched grid in - latitude and altitude. For a fuller description of using GITM within DART, please see the :doc:`./readme` documentation. -| ``netcdf_to_gitm_blocks`` is the program that updates the GITM restart files (i.e. ``b?????.rst``) with the - information from a DART output/restart file (e.g. ``perfect_ics, filter_ics, ...``). -| The list of variables used to create the DART state vector are specified in the ``input.nml`` file. -| Conditions required for successful execution of ``netcdf_to_gitm_blocks``: - -- a valid ``input.nml`` namelist file for DART -- a valid ``UAM.in`` control file for GITM -- a set of ``b?????.rst`` data files for GITM -- a ``header.rst`` file for GITM -- the DART/GITM interfaces must be compiled in a manner consistent with the GITM data and control files. The following - GITM source files are required to build *any* DART interface: - - - models/gitm/GITM2/src/ModConstants.f90 - - models/gitm/GITM2/src/ModEarth.f90 - - models/gitm/GITM2/src/ModKind.f90 - - models/gitm/GITM2/src/ModOrbital.f90 - - models/gitm/GITM2/src/ModSize.f90 - - models/gitm/GITM2/src/ModTime.f90 - - models/gitm/GITM2/src/time_routines.f90 - - Versions of these are included in the DART release. ``ModSize.f90``, in particular, must match what was used to - create the ``b????.rst`` files. - -The individual model instances are run in unique directories. This is also where the converter routines ``gitm_to_dart`` -and ``netcdf_to_gitm_blocks`` are run. This makes it easy to use a single 'static' name for the input and output -filenames. ``advance_model.csh`` is responsibile for linking the appropriate files to these static filenames. - -The simplest way to test the converter is to compile GITM and run a single model state forward using ``work/clean.sh``. -To build GITM ... download GITM and unpack the code into ``DART/models/gitm/GITM2`` and follow these instructions: - -.. container:: unix - - :: - - cd models/gitm/GITM2 - ./Config.pl -install -compiler=ifortmpif90 -earth - make - cd ../work - ./clean.sh 1 1 0 150.0 170.0 1.0 - - And then manually run ``netcdf_to_gitm_blocks`` on the result. - -Namelist --------- - -We adhere to the F90 standard of starting a namelist with an ampersand '&' and terminating with a slash '/' for all our -namelist input. Character strings that contain a '/' must be enclosed in quotes to prevent them from prematurely -terminating the namelist. - -:: - - &netcdf_to_gitm_blocks_nml - netcdf_to_gitm_blocks_output_file = 'dart_restart', - advance_time_present = .false. - / - - &model_nml - gitm_restart_dirname = 'advance_temp_e1/UA/restartOUT', - assimilation_period_days = 0, - assimilation_period_seconds = 1800, - model_perturbation_amplitude = 0.2, - output_state_vector = .false., - calendar = 'Gregorian', - debug = 0, - gitm_state_variables = 'Temperature', 'QTY_TEMPERATURE', - 'eTemperature', 'QTY_TEMPERATURE_ELECTRON', - 'ITemperature', 'QTY_TEMPERATURE_ION', - 'iO_3P_NDensityS', 'QTY_DENSITY_NEUTRAL_O3P', - ... - -+-----------------------------------+--------------------+-----------------------------------------------------------+ -| Contents | Type | Description | -+===================================+====================+===========================================================+ -| netcdf_to_gitm_blocks_output_file | character(len=128) | The name of the DART file containing the model state | -| | | derived from the GITM restart files. | -+-----------------------------------+--------------------+-----------------------------------------------------------+ -| advance_time_present | logical | If you are manually converting a DART initial conditions | -| | | or restart file this should be ``.false.``; these files | -| | | have a single timestamp describing the valid time of the | -| | | model state. If ``.true.``, TWO timestamps are expected | -| | | in the DART file header and | -| | | ``DART_GITM_time_control.txt``) is created with the | -| | | settings appropriate to advance GITM to the time | -| | | requested by DART. | -+-----------------------------------+--------------------+-----------------------------------------------------------+ - -| - -The full description of the ``model_nml`` namelist is documented in the `gitm model_mod `__, -but the most important variable for ``netcdf_to_gitm_blocks`` is repeated here. - -+---------------------------------------+---------------------------------------+---------------------------------------+ -| Contents | Type | Description | -+=======================================+=======================================+=======================================+ -| gitm_restart_dirname | character(len=256) | The name of the directory containing | -| | | the GITM restart files and runtime | -| | | control information. | -+---------------------------------------+---------------------------------------+---------------------------------------+ -| gitm_state_variables | character(len=32), | The list of variable names in the | -| | dimension(2,80) | gitm restart file to use to create | -| | | the DART state vector and their | -| | | corresponding DART kind. The default | -| | | list is specified in | -| | | model_mod.nml | -+---------------------------------------+---------------------------------------+---------------------------------------+ - -Modules used ------------- - -:: - - obs_def_upper_atm_mod.f90 - assim_model_mod.f90 - types_mod.f90 - location/threed_sphere/location_mod.f90 - models/gitm/GITM2/src/ModConstants.f90 - models/gitm/GITM2/src/ModEarth.f90 - models/gitm/GITM2/src/ModKind.f90 - models/gitm/GITM2/src/ModSize.f90 - models/gitm/GITM2/src/ModTime.f90 - models/gitm/GITM2/src/time_routines.f90 - models/gitm/dart_gitm_mod.f90 - models/gitm/netcdf_to_gitm_blocks.f90 - models/gitm/model_mod.f90 - null_mpi_utilities_mod.f90 - obs_kind_mod.f90 - random_seq_mod.f90 - time_manager_mod.f90 - utilities_mod.f90 - -Files read ----------- - -- gitm restart files: ``b????.rst`` -- gitm control files: ``header.rst`` -- gitm control files: ``UAM.in.rst`` -- DART namelist file: ``input.nml`` - -Files written -------------- - -- DART initial conditions/restart file; e.g. ``dart_ics`` - -References ----------- - -- The official ``GITM`` site is: can be found at - `ccmc.gsfc.nasa.gov/models/modelinfo.php?model=GITM `__ From 7407ba21121d93e7c9eee99506422d86d4622b36 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 30 Jan 2024 13:19:45 -0700 Subject: [PATCH 070/124] remove tiegcm files --- models/aether_lon-lat/work/f10_7.cdl | 10 --------- models/aether_lon-lat/work/f10_7.nc | Bin 156 -> 0 bytes .../work/out_restart_p_files.txt | 20 ------------------ .../work/out_secondary_files.txt | 20 ------------------ .../aether_lon-lat/work/restart_p_files.txt | 1 - .../aether_lon-lat/work/secondary_files.txt | 1 - 6 files changed, 52 deletions(-) delete mode 100644 models/aether_lon-lat/work/f10_7.cdl delete mode 100644 models/aether_lon-lat/work/f10_7.nc delete mode 100644 models/aether_lon-lat/work/out_restart_p_files.txt delete mode 100644 models/aether_lon-lat/work/out_secondary_files.txt delete mode 100644 models/aether_lon-lat/work/restart_p_files.txt delete mode 100644 models/aether_lon-lat/work/secondary_files.txt diff --git a/models/aether_lon-lat/work/f10_7.cdl b/models/aether_lon-lat/work/f10_7.cdl deleted file mode 100644 index a3c55e4583..0000000000 --- a/models/aether_lon-lat/work/f10_7.cdl +++ /dev/null @@ -1,10 +0,0 @@ -netcdf f10_7 { // example f10.7 netcdf file for DART -dimensions: - parameter = 1 ; -variables: - double f10_7(parameter) ; -// global attributes - :title = "example f10.7 netcdf file for DART" ; -data: - f10_7 = 70; -} diff --git a/models/aether_lon-lat/work/f10_7.nc b/models/aether_lon-lat/work/f10_7.nc deleted file mode 100644 index 88497c975d19fc53cb25b8422bc697e6db60a9fd..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 156 zcmZ>EabskF04^W}VsjQG7A5AUmZTOz#6e;_P&w9;%#xf`h&U6FQcA5z%q_@CRY)^5 z&@)%aOD#!GNmEG61c~GqDY!TWg@6@v!}J5y#hXL)!|a9d7#P@q3=SZk;t<#X76Skf CHx*p~ diff --git a/models/aether_lon-lat/work/out_restart_p_files.txt b/models/aether_lon-lat/work/out_restart_p_files.txt deleted file mode 100644 index 02219d5699..0000000000 --- a/models/aether_lon-lat/work/out_restart_p_files.txt +++ /dev/null @@ -1,20 +0,0 @@ -out_tiegcm_restart_p_01.nc -out_tiegcm_restart_p_02.nc -out_tiegcm_restart_p_03.nc -out_tiegcm_restart_p_04.nc -out_tiegcm_restart_p_05.nc -out_tiegcm_restart_p_06.nc -out_tiegcm_restart_p_07.nc -out_tiegcm_restart_p_08.nc -out_tiegcm_restart_p_09.nc -out_tiegcm_restart_p_10.nc -out_tiegcm_restart_p_11.nc -out_tiegcm_restart_p_12.nc -out_tiegcm_restart_p_13.nc -out_tiegcm_restart_p_14.nc -out_tiegcm_restart_p_15.nc -out_tiegcm_restart_p_16.nc -out_tiegcm_restart_p_17.nc -out_tiegcm_restart_p_18.nc -out_tiegcm_restart_p_19.nc -out_tiegcm_restart_p_20.nc diff --git a/models/aether_lon-lat/work/out_secondary_files.txt b/models/aether_lon-lat/work/out_secondary_files.txt deleted file mode 100644 index d2773e20e0..0000000000 --- a/models/aether_lon-lat/work/out_secondary_files.txt +++ /dev/null @@ -1,20 +0,0 @@ -out_tiegcm_s_01.nc -out_tiegcm_s_02.nc -out_tiegcm_s_03.nc -out_tiegcm_s_04.nc -out_tiegcm_s_05.nc -out_tiegcm_s_06.nc -out_tiegcm_s_07.nc -out_tiegcm_s_08.nc -out_tiegcm_s_09.nc -out_tiegcm_s_10.nc -out_tiegcm_s_11.nc -out_tiegcm_s_12.nc -out_tiegcm_s_13.nc -out_tiegcm_s_14.nc -out_tiegcm_s_15.nc -out_tiegcm_s_16.nc -out_tiegcm_s_17.nc -out_tiegcm_s_18.nc -out_tiegcm_s_19.nc -out_tiegcm_s_20.nc diff --git a/models/aether_lon-lat/work/restart_p_files.txt b/models/aether_lon-lat/work/restart_p_files.txt deleted file mode 100644 index 742bd03c80..0000000000 --- a/models/aether_lon-lat/work/restart_p_files.txt +++ /dev/null @@ -1 +0,0 @@ -tiegcm_restart_p.nc diff --git a/models/aether_lon-lat/work/secondary_files.txt b/models/aether_lon-lat/work/secondary_files.txt deleted file mode 100644 index b430a9d435..0000000000 --- a/models/aether_lon-lat/work/secondary_files.txt +++ /dev/null @@ -1 +0,0 @@ -tiegcm_s.nc From a1f5a4d917f207c763a41e630bdefa33ce4bda7a Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 30 Jan 2024 13:44:35 -0700 Subject: [PATCH 071/124] remove svn junk --- models/aether_lon-lat/aether_to_dart.f90 | 12 +-- models/aether_lon-lat/dart_to_aether.f90 | 11 -- models/aether_lon-lat/model_mod.f90 | 127 +++++++++++------------ 3 files changed, 62 insertions(+), 88 deletions(-) diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index d3f75de5db..6e2e4c2245 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -32,12 +32,6 @@ program aether_to_dart 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=*), parameter :: program_name = 'aether_to_dart' ! !----------------------------------------------------------------------- @@ -66,6 +60,7 @@ program aether_to_dart !---------------------------------------------------------------------- ! Get the ensemble member ! TODO: The script must echo the member number to the aether_to_dart. +! TODO: use COMMAND_LINE_ARGUMENT !---------------------------------------------------------------------- member = -88 read '(I3)', member @@ -99,8 +94,3 @@ program aether_to_dart end program aether_to_dart -! -! $URL$ -! $Id$ -! $Revision$ -! $Date$ diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90 index 1331e740a2..fc7e9a4aa7 100644 --- a/models/aether_lon-lat/dart_to_aether.f90 +++ b/models/aether_lon-lat/dart_to_aether.f90 @@ -2,7 +2,6 @@ ! by UCAR, "as is", without charge, subject to all terms of use at ! http://www.image.ucar.edu/DAReS/DART/DART_download ! -! $Id$ program dart_to_aether @@ -27,11 +26,6 @@ program dart_to_aether 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=*), parameter :: progname = 'dart_to_aether' !---------------------------------------------------------------------- @@ -65,8 +59,3 @@ program dart_to_aether end program dart_to_aether -! -! $URL$ -! $Id$ -! $Revision$ -! $Date$ diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index e21166635a..3ce591e9a2 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -99,8 +99,6 @@ module model_mod block_file_name character(len=256), parameter :: source = 'aether_lon-lat/model_mod.f90' -character(len=32 ), parameter :: revision = '' -character(len=32 ), parameter :: revdate = '' logical :: module_initialized = .false. integer :: dom_id ! used to access the state structure @@ -240,9 +238,6 @@ subroutine static_init_model() module_initialized = .true. -! Print module information to log file and stdout. -call register_module(source) - 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") @@ -341,7 +336,7 @@ subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs IF (debug > 85) then write(error_string_1,'(A,3F15.4)') 'requesting interpolation at ', llon, llat, lvert - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) end if ! Only height and level for vertical location type is supported at this point @@ -368,7 +363,7 @@ subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs if(debug > 12) then write(error_string_1,'(A,I5,A)') 'Did not find observation quantity ', qty, & ' in the state vector' - call error_handler(E_WARN, routine, error_string_1, source, revision, revdate) + call error_handler(E_WARN, routine, error_string_1, source) endif istatus(:) = status1 ! this quantity not in the state vector return @@ -664,7 +659,7 @@ subroutine verify_variables(variables, file, nvar, & error_string_1 = 'model_nml: variable list not fully specified' error_string_2 = 'reading from "'//trim(filter_io_filename)//'"' call error_handler(E_ERR, routine, error_string_1, & - source, revision, revdate, text2=error_string_2) + source, text2=error_string_2) endif ! The internal DART routines check if the variable name is valid. @@ -674,7 +669,7 @@ subroutine verify_variables(variables, file, nvar, & if( quantity < 0 ) then write(error_string_1,'(''there is no obs_kind "'',a,''" in obs_kind_mod.f90'')') & trim(dartstr) - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif ! All good to here - fill the output variables @@ -702,7 +697,7 @@ subroutine verify_variables(variables, file, nvar, & if (nvar == MAX_STATE_VARIABLES) then error_string_1 = 'WARNING: you may need to increase "MAX_STATE_VARIABLES"' write(error_string_2,'(''you have specified at least '',i4,'' perhaps more.'')') nvar - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate, text2=error_string_2) + call error_handler(E_MSG, routine, error_string_1, source, text2=error_string_2) endif end subroutine verify_variables @@ -743,7 +738,7 @@ subroutine get_quad_vals(state_handle, ens_size, varid, four_lons, four_lats, & else istatus(:) = INVALID_VERT_COORD_ERROR_CODE write(error_string_1, *) 'unsupported vertical type: ', which_vert - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif ! we have all the indices and fractions we could ever want. @@ -757,7 +752,7 @@ subroutine get_quad_vals(state_handle, ens_size, varid, four_lons, four_lats, & lev1, lev2, vert_fract, varid, quad_vals, istatus) else write(error_string_1, *) 'unsupported variable: ', varid - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif if (any(istatus /= 0)) return @@ -817,7 +812,7 @@ subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & write(error_string_1,'(A)') 'Could not find dart state index from ' write(error_string_2,'(A,3F15.4)') 'lon, lat, and lev1 index :', & four_lons(icorner), four_lats(icorner), lev1 - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate, & + call error_handler(E_ERR, routine, error_string_1, source, & text2=error_string_2) return endif @@ -831,7 +826,7 @@ subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & write(error_string_1,'(A)') 'Could not find dart state index from ' write(error_string_2,'(A,3F15.4)') 'lon, lat, and lev2 index :', & four_lons(icorner), four_lats(icorner), lev2 - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate, & + call error_handler(E_ERR, routine, error_string_1, source, & text2=error_string_2) return endif @@ -918,7 +913,7 @@ subroutine restart_files_to_netcdf(member) if (module_initialized ) then write(error_string_1,'(3A)')'The aether static_init_model was already initialized but ', & trim(routine), ' uses a separate initialization procedure' - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source ) end if call static_init_blocks("aether_to_dart_nml") @@ -978,18 +973,18 @@ subroutine netcdf_to_restart_files(member) if (module_initialized ) then write(error_string_1,'(3A)')'The aether mod was already initialized but ', & trim(routine), ' uses a separate initialization procedure' - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source ) end if call static_init_blocks("dart_to_aether_nml") write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member + 1,'.nc' -call error_handler(E_MSG, routine, '', '', revision, revdate) +call error_handler(E_MSG, routine, '', '') write(error_string_1,'(3A)') 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" write(error_string_2,'(3A)') 'into Aether restart files in directory ', & "'"//trim(aether_restart_dirname)//"'" -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate, text2=error_string_2) +call error_handler(E_MSG, routine, error_string_1, source, text2=error_string_2) ncid = nc_open_file_readonly(filter_io_filename, routine) @@ -998,10 +993,10 @@ subroutine netcdf_to_restart_files(member) !---------------------------------------------------------------------- ! Log what we think we're doing, and exit. !---------------------------------------------------------------------- -call error_handler(E_MSG, routine,'','', revision, revdate) +call error_handler(E_MSG, routine,'','') write(error_string_1,'(3A)') 'Successfully converted to the Aether restart files in directory' write(error_string_2,'(3A)') "'"//trim(aether_restart_dirname)//"'" -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate, text2=error_string_2) +call error_handler(E_MSG, routine, error_string_1, source, text2=error_string_2) call nc_close_file(ncid) @@ -1028,7 +1023,7 @@ function block_file_name(filetype, memnum, blocknum) if ( debug > 0 ) then write(error_string_1,'("filename, memnum, blocknum = ",A,2(1x,i5))') & trim(block_file_name), memnum, blocknum - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif end function block_file_name @@ -1094,7 +1089,7 @@ subroutine static_init_blocks(nml) if( debug > 0 ) then write(error_string_1,'(A,3I5)') 'grid dims are ', nlon, nlat, nlev - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif ! Opens and closes the grid block file, but not the filter netcdf file. @@ -1114,7 +1109,7 @@ subroutine static_init_blocks(nml) if ( debug > 0 ) then write(error_string_1,'("grid: nlon, nlat, nlev =",3(1x,i5))') nlon, nlat, nlev - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif end subroutine static_init_blocks @@ -1157,7 +1152,7 @@ subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & if (debug > 4) then write(error_string_1,'(3A)') 'Now opening Aether UAM file: ', trim(file_loc) -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) end if @@ -1171,7 +1166,7 @@ subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & ! If we get to the end of the file or hit a read error without ! finding what we need, die. write(error_string_1,'(3A)') 'cannot find #GRID in ', trim(file_loc) -call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +call error_handler(E_ERR, routine, error_string_1, source) endif if (c_line(1:5) .ne. "#GRID") cycle UAMREAD @@ -1189,19 +1184,19 @@ subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & if (debug > 4) then write(error_string_1,'(3A)') 'Successfully read Aether UAM grid file:', trim(file_loc) -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)') ' nblocks_lon:', nblocks_lon -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)') ' nblocks_lat:', nblocks_lat -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)') ' nblocks_lev:', nblocks_lev -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,F15.4)') ' lat_start:', lat_start -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,F15.4)') ' lat_end:', lat_end -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,F15.4)') ' lon_start:', lon_start -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) end if call close_file(iunit) @@ -1250,11 +1245,11 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, nlev = nblocks_lev * nz_per_block write(error_string_1,'(A,I5)') 'nlon = ', nlon -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)') 'nlat = ', nlat -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)') 'nlev = ', nlev -call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) +call error_handler(E_MSG, routine, error_string_1, source) ! TODO; do these need to be deallocated somewhere? ! Probably not; this is only done once, and these arrays are needed @@ -1265,13 +1260,13 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, if (debug > 4) then write(error_string_1,'(2A)') 'Successfully read Aether grid file:', trim(filename) - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)') ' nx_per_block:', nx_per_block - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)') ' ny_per_block:', ny_per_block - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)') ' nz_per_block:', nz_per_block - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif ! A temp array large enough to hold any of the 3D @@ -1294,7 +1289,7 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, if ( debug > 0 ) then write(error_string_1,'(2(A,3i5),A,3(1X,i5))') & 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif ! go across the south-most block row picking up all longitudes @@ -1369,11 +1364,11 @@ subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, if ( debug > 1 ) then ! Check dimension limits write(error_string_1,'(A,2F15.4)') 'LON range ', minval(lons), maxval(lons) - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,2F15.4)') 'LAT range ', minval(lats), maxval(lats) - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,2F15.4)') 'ALT range ', minval(levs), maxval(levs) - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif end subroutine get_grid_from_blocks @@ -1413,11 +1408,11 @@ function read_aether_time(filename) if (debug > 8) then write(error_string_1,'(A,I5)')'tsimulation ', tsimulation - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)')'ndays ', ndays - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(A,I5)')'nsecs ', nsecs - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) call print_date(aether_ref_time, routine//':model base date') call print_time(aether_ref_time, routine//':model base time') @@ -1548,12 +1543,12 @@ function open_block_file(filename, rw) if ( .not. file_exist(filename) ) then write(error_string_1,'(4A)') 'cannot open file ', filename,' for ', rw - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif if (debug > 0) then write(error_string_1,'(4A)') 'Opening file ', trim(filename), ' for ', rw - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) end if @@ -1563,13 +1558,13 @@ function open_block_file(filename, rw) open_block_file = nc_open_file_readwrite(filename, routine) else error_string_1 = ': must be called with rw={read,readwrite}, not '//rw - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif if (debug > 80) then write(error_string_1,'(4A)') 'Returned file descriptor is ', open_block_file - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) end if end function open_block_file @@ -1636,7 +1631,7 @@ function read_in_real(iunit, varname, filter_io_filename) read(iunit,'(a)',iostat=ios) c_line if (ios /= 0) then write(error_string_1,'(4A)') 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif ! Remove anything after a space or TAB @@ -1648,7 +1643,7 @@ function read_in_real(iunit, varname, filter_io_filename) if(ios /= 0) then write(error_string_1,'(4A)')'unable to read '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif end function read_in_real @@ -1671,7 +1666,7 @@ function read_in_int(iunit, varname, filter_io_filename) read(iunit,'(a)',iostat=ios) c_line if (ios /= 0) then write(error_string_1,'(4A)') 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'get_grid_dims', error_string_1, source, revision, revdate) + call error_handler(E_ERR,'get_grid_dims', error_string_1, source) endif ! Remove anything after a space or TAB @@ -1682,7 +1677,7 @@ function read_in_int(iunit, varname, filter_io_filename) if(ios /= 0) then write(error_string_1,'(4A)')'unable to read '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate, & + call error_handler(E_ERR, routine, error_string_1, source, & text2=c_line) endif @@ -1837,7 +1832,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) if (debug > 10 .and. do_output()) then write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':', dart_varname - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) end if call nc_define_real_variable(ncid_output, dart_varname, & @@ -1858,7 +1853,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) else write(error_string_1,'(A,I3,A)') 'Trying to read neutrals, but variables(', & VT_ORIGININDX,ivar , ') /= "neutrals"' - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif enddo @@ -1877,7 +1872,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) if (debug > 10 .and. do_output()) then write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':', dart_varname - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) end if call nc_define_real_variable(ncid_output, dart_varname, & @@ -1892,7 +1887,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) else write(error_string_1,'(A,I3,A)') 'Trying to read ions, but variables(', & VT_ORIGININDX,ivar , ') /= "ions"' - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif enddo @@ -1907,7 +1902,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! ! if (no_idensity) then ! write(error_string_1,*) 'Cannot compute the VTEC without the electron density' -! call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) +! call error_handler(E_ERR, routine, error_string_1, source) ! end if ! ! temp2d = 0._r8 @@ -1968,7 +1963,7 @@ subroutine filter_to_restarts(ncid, member) varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) if (debug >= 0 .and. do_output()) then write(error_string_1,'("varname = ",A)') trim(varname) - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif dart_varname = aether_name_to_dart(varname) @@ -2001,7 +1996,7 @@ subroutine filter_to_restarts(ncid, member) if (debug >= 0 .and. do_output()) then write(error_string_1,'("varname, dart_varname, file_root = ",3(2x,A))') & trim(varname), trim(dart_varname), file_root - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif if (file_root == 'ions') then @@ -2090,7 +2085,7 @@ subroutine add_halo_fulldom3d(fulldom3d) if (any(fulldom3d == MISSING_R4)) then error_string_1 = 'ERROR: some fulldom3d contain MISSING_R4 after halos' - call error_handler(E_ERR, routine, error_string_1, source, revision, revdate) + call error_handler(E_ERR, routine, error_string_1, source) endif ! TODO: Keep halo corners check for future use? @@ -2111,7 +2106,7 @@ subroutine add_halo_fulldom3d(fulldom3d) ! Debug HDF5 write(error_string_1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))') normed(nlat+1,nlon+2) - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) ! 17 format debug_format print*,'top' @@ -2173,7 +2168,7 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) if (debug > 0 .and. do_output()) then write(error_string_1,'(A,I0,A,I0,A)') 'Now putting the data for ', nblocks_lon, & ' blocks lon by ',nblocks_lat,' blocks lat' - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) end if starts(1) = 1 @@ -2195,10 +2190,10 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) ! TODO: error checking; does the block file have the field in it? if ( debug > 0 .and. do_output()) then write(error_string_1,'(A,3(2X,i5))') "block, ib, jb = ", nb, ib, jb - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) write(error_string_1,'(3(A,3i5))') & 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount - call error_handler(E_MSG, routine, error_string_1, source, revision, revdate) + call error_handler(E_MSG, routine, error_string_1, source) endif call nc_put_variable(ncid_output, trim(varname), & From c84121e0e0274bf0733dbda90b142b3e519a4cf0 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 30 Jan 2024 15:47:53 -0500 Subject: [PATCH 072/124] fix typo model directory --- index.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/index.rst b/index.rst index 038d45a345..4d6ece9409 100644 --- a/index.rst +++ b/index.rst @@ -371,7 +371,7 @@ References :hidden: models/9var/readme - models/aether/readme + models/aether_lon-lat/readme models/am2/readme models/bgrid_solo/readme models/cam-fv/readme From cc14e93ce77dbb09dbe28c91bfd7642627b93178 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 30 Jan 2024 15:18:19 -0700 Subject: [PATCH 073/124] remove unneeded/outdated docs --- models/aether_lon-lat/readme.rst | 653 ------------------------------- 1 file changed, 653 deletions(-) diff --git a/models/aether_lon-lat/readme.rst b/models/aether_lon-lat/readme.rst index 37352f2ed8..5847fbead5 100644 --- a/models/aether_lon-lat/readme.rst +++ b/models/aether_lon-lat/readme.rst @@ -111,656 +111,3 @@ For example 'velocity_parallel_east\ \(O+_2D\)' becomes | -Other modules used ------------------- - -:: - -default_model_mod -distributed_state_mod -ensemble_manager_mod -location_mod -netcdf_utilities_mod -obs_kind_mod -quad_utils_mod -state_structure_mod -types_mod -time_manager_mod -utilities_mod - -Public interfaces ------------------ - -======================= =================================== -*use model_mod, only :* get_model_size -\ adv_1step -\ get_state_meta_data -\ model_interpolate -\ shortest_time_between_assimilations -\ static_init_model -\ init_time -\ init_conditions -\ nc_write_model_atts -\ nc_write_model_vars -\ pert_model_copies -\ get_close_obs -\ get_close_state -\ convert_vertical_obs -\ convert_vertical_state -\ read_model_time -\ write_model_time -\ end_model -======================= =================================== - -A note about documentation style. Optional arguments are enclosed in brackets *[like this]*. - -| - -.. container:: routine - - *model_size = get_model_size( )* - :: - - integer(i8) :: get_model_size - -.. container:: indent1 - - Returns the length of the model state vector. Required. - - ============== ===================================== - ``model_size`` The length of the model state vector. - ============== ===================================== - -| - -.. container:: routine - - *call adv_1step(x, time)* - :: - - real(r8), dimension(:), intent(inout) :: x - type(time_type), intent(in) :: time - -.. container:: indent1 - - Does a single timestep advance of the model. The input value of the vector x is the starting condition and x must be - updated to reflect the changed state after a timestep. The time argument is intent in and is used for models that - need to know the date/time to compute a timestep, for instance for radiation computations. This interface is only - called if the namelist parameter async is set to 0 in ``perfect_model_obs`` or ``filter`` or if the program - ``integrate_model`` is to be used to advance the model state as a separate executable. If one of these options is not - going to be used (the model will *only* be advanced as a separate model-specific executable), this can be a NULL - INTERFACE. (The subroutine name must still exist, but it can contain no code and it will not be called.) - - ======== ================================== - ``x`` State vector of length model_size. - ``time`` Current time of the model state. - ======== ================================== - -| - -.. container:: routine - - *call get_state_meta_data (index_in, location, [, var_type] )* - :: - - integer, intent(in) :: index_in - type(location_type), intent(out) :: location - integer, optional, intent(out) :: var_type - -.. container:: indent1 - - Given an integer index into the state vector, returns the associated location. An optional argument returns the - generic quantity of this item, e.g. QTY_TEMPERATURE, QTY_DENSITY, QTY_SALINITY, QTY_U_WIND_COMPONENT. This interface - is required to be functional for all applications. - - ============ =================================================================== - ``index_in`` Index of state vector element about which information is requested. - ``location`` The location of state variable element. - *var_type* The generic quantity of the state variable element. - ============ =================================================================== - -| - -.. container:: routine - - *call model_interpolate(state_handle, ens_size, location, obs_quantity, expected_obs, istatus)* - :: - - type(ensemble_type), intent(in) :: state_handle - integer, intent(in) :: ens_size - type(location_type), intent(in) :: location - integer, intent(in) :: obs_quantity - real(r8), intent(out) :: expected_obs(ens_size) - integer, intent(out) :: istatus(ens_size) - -.. container:: indent1 - - Given a handle containing information for a state vector, an ensemble size, a location, and a model state variable - quantity interpolates the state variable field to that location and returns an ensemble-sized array of values in - ``expected_obs(:)``. The ``istatus(:)`` array should be 0 for successful ensemble members and a positive value for - failures. The ``obs_quantity`` variable is one of the quantity (QTY) parameters defined in the - :doc:`../../assimilation_code/modules/observations/obs_kind_mod` file and defines the quantity to interpolate. In - low-order models that have no notion of kinds of variables this argument may be ignored. For applications in which - only perfect model experiments with identity observations (i.e. only the value of a particular state variable is - observed), this can be a NULL INTERFACE. Otherwise it is required (which is the most common case). - - +------------------+--------------------------------------------------------------------------------------------------+ - | ``state_handle`` | The handle to the state structure containing information about the state vector about which | - | | information is requested. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``ens_size`` | The ensemble size. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``location`` | Location to which to interpolate. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``obs_quantity`` | Quantity of state field to be interpolated. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``expected_obs`` | The interpolated values from the model. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``istatus`` | Integer values return 0 for success. Other positive values can be defined for various failures. | - +------------------+--------------------------------------------------------------------------------------------------+ - -| - -.. container:: routine - - *var = shortest_time_between_assimilations()* - :: - - type(time_type) :: shortest_time_between_assimilations - -.. container:: indent1 - - Returns the smallest increment in time that the model is capable of advancing the state in a given implementation. - The actual value may be set by the model_mod namelist (depends on the model). This interface is required for all - applications. - - ======= =================================== - ``var`` Smallest advance time of the model. - ======= =================================== - -| - -.. container:: routine - - *call static_init_model()* - -.. container:: indent1 - - Called to do one time initialization of the model. As examples, might define information about the model size or - model timestep, read in grid information, read a namelist, set options, etc. In models that require pre-computed - static data, for instance spherical harmonic weights, these would also be computed here. Can be a NULL INTERFACE for - the simplest models. - -| - -.. container:: routine - - *call init_time(time)* - :: - - type(time_type), intent(out) :: time - -.. container:: indent1 - - Companion interface to init_conditions. Returns a time that is somehow appropriate for starting up a long integration - of the model. At present, this is only used if the ``perfect_model_obs`` namelist parameter - ``read_input_state_from_file = .false.`` If this option should not be used in ``perfect_model_obs``, calling this - routine should issue a fatal error. - - ======== =================== - ``time`` Initial model time. - ======== =================== - -| - -.. container:: routine - - *call init_conditions(x)* - :: - - real(r8), dimension(:), intent(out) :: x - -.. container:: indent1 - - Returns a model state vector, x, that is some sort of appropriate initial condition for starting up a long - integration of the model. At present, this is only used if the ``perfect_model_obs`` namelist parameter - ``read_input_state_from_file = .false.`` If this option should not be used in ``perfect_model_obs``, calling this - routine should issue a fatal error. - - ===== ==================================== - ``x`` Initial conditions for state vector. - ===== ==================================== - -| - -.. container:: routine - - *call nc_write_model_atts(ncFileID, domain_id)* - :: - - integer, intent(in) :: ncFileID - integer, intent(in) :: domain_id - -.. container:: indent1 - - | This routine writes the model-specific attributes to netCDF files that DART creates. This includes coordinate - variables and any metadata, but NOT the actual model state vector. ``models/template/model_mod.f90`` contains code - that can be used for any model as-is. - | The typical sequence for adding new dimensions, variables, attributes: - - :: - - NF90_OPEN ! open existing netCDF dataset - NF90_redef ! put into define mode - NF90_def_dim ! define additional dimensions (if any) - NF90_def_var ! define variables: from name, kind, and dims - NF90_put_att ! assign attribute values - NF90_ENDDEF ! end definitions: leave define mode - NF90_put_var ! provide values for variable - NF90_CLOSE ! close: save updated netCDF dataset - - +---------------+-----------------------------------------------------------------------------------------------------+ - | ``ncFileID`` | Integer file descriptor to previously-opened netCDF file. | - +---------------+-----------------------------------------------------------------------------------------------------+ - | ``domain_id`` | integer describing the domain (which can be a nesting level, a component model ...) Models with | - | | nested grids are decomposed into 'domains' in DART. The concept is extended to refer to 'coupled' | - | | models where one model component may be the atmosphere, another component may be the ocean, or | - | | land, or ionosphere ... these would be referenced as different domains. | - +---------------+-----------------------------------------------------------------------------------------------------+ - -| - -.. container:: routine - - *call nc_write_model_vars(ncFileID, domain_id, state_ens_handle [, memberindex] [, timeindex])* - :: - - integer, intent(in) :: ncFileID - integer, intent(in) :: domain_id - type(ensemble_type), intent(in) :: state_ens_handle - integer, optional, intent(in) :: memberindex - integer, optional, intent(in) :: timeindex - -.. container:: indent1 - - | This routine may be used to write the model-specific state vector (data) to a netCDF file. Only used if - ``model_mod_writes_state_variables = .true.`` - | Typical sequence for adding new dimensions,variables,attributes: - - :: - - NF90_OPEN ! open existing netCDF dataset - NF90_redef ! put into define mode - NF90_def_dim ! define additional dimensions (if any) - NF90_def_var ! define variables: from name, kind, and dims - NF90_put_att ! assign attribute values - NF90_ENDDEF ! end definitions: leave define mode - NF90_put_var ! provide values for variable - NF90_CLOSE ! close: save updated netCDF dataset - - +----------------------+----------------------------------------------------------------------------------------------+ - | ``ncFileID`` | file descriptor to previously-opened netCDF file. | - +----------------------+----------------------------------------------------------------------------------------------+ - | ``domain_id`` | integer describing the domain (which can be a nesting level, a component model ...) | - +----------------------+----------------------------------------------------------------------------------------------+ - | ``state_ens_handle`` | The handle to the state structure containing information about the state vector about which | - | | information is requested. | - +----------------------+----------------------------------------------------------------------------------------------+ - | ``memberindex`` | Integer index of ensemble member to be written. | - +----------------------+----------------------------------------------------------------------------------------------+ - | ``timeindex`` | The timestep counter for the given state. | - +----------------------+----------------------------------------------------------------------------------------------+ - -| - -.. container:: routine - - *call 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 - logical, intent(out) :: interf_provided - -.. container:: indent1 - - Given an ensemble handle, the ensemble size, and a perturbation amplitude; perturb the ensemble. Used to generate - initial conditions for spinning up ensembles. If the ``model_mod`` does not want to do this, instead allowing the - default algorithms in ``filter`` to take effect, ``interf_provided =&nbps;.false.`` and the routine can be trivial. - Otherwise, ``interf_provided`` must be returned as ``.true.`` - - +----------------------+----------------------------------------------------------------------------------------------+ - | ``state_ens_handle`` | The handle containing an ensemble of state vectors to be perturbed. | - +----------------------+----------------------------------------------------------------------------------------------+ - | ``ens_size`` | The number of ensemble members to perturb. | - +----------------------+----------------------------------------------------------------------------------------------+ - | ``pert_amp`` | the amplitude of the perturbations. The interpretation is based on the model-specific | - | | implementation. | - +----------------------+----------------------------------------------------------------------------------------------+ - | ``interf_provided`` | Returns false if model_mod cannot do this, else true. | - +----------------------+----------------------------------------------------------------------------------------------+ - -| - -.. container:: routine - - *call get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, num_close, close_ind [, dist] [, - state_handle)* - :: - - type(get_close_type), intent(in) :: gc - type(location_type), intent(in) :: base_loc - integer, intent(in) :: base_type - type(location_type), intent(in) :: locs(:) - integer, intent(in) :: loc_qtys(:) - integer, intent(in) :: loc_types(:) - integer, intent(out) :: num_close - integer, intent(out) :: close_ind(:) - real(r8), optional, intent(out) :: dist(:) - type(ensemble_type), optional, intent(in) :: state_handle - -.. container:: indent1 - - | Given a location and quantity, compute the distances to all other locations in the ``obs`` list. The return values - are the number of items which are within maxdist of the base, the index numbers in the original obs list, and - optionally the distances. The ``gc`` contains precomputed information to speed the computations. - | In general this is a PASS-THROUGH ROUTINE. It is listed on the use line for the locations_mod, and in the public - list for this module, but has no subroutine declaration and no other code in this module: - - :: - - use location_mod, only: get_close_obs - - public :: get_close_obs - - However, if the model needs to alter the values or wants to supply an alternative implementation it can intercept the - call like so: - - :: - - use location_mod, only: & - lm_get_close_obs => get_close_obs - - public :: get_close_obs - - In this case a local ``get_close_obs()`` routine must be supplied. To call the original code in the location module - use: - - :: - - call lm_get_close_obs(gc, base_loc, ...) - - | This subroutine will be called after ``get_close_maxdist_init`` and ``get_close_obs_init``. - | In most cases the PASS-THROUGH ROUTINE will be used, but some models need to alter the actual distances depending - on the observation or state vector kind, or based on the observation or state vector location. It is reasonable in - this case to leave ``get_close_maxdist_init()`` and ``get_close_obs_init()`` as pass-through routines and intercept - only ``get_close_obs()``. The local ``get_close_obs()`` can first call the location mod routine and let it return a - list of values, and then inspect the list and alter or remove any entries as needed. See the CAM and WRF model_mod - files for examples of this use. - - +------------------+--------------------------------------------------------------------------------------------------+ - | ``gc`` | The get_close_type which stores precomputed information about the locations to speed up | - | | searching | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``base_loc`` | Reference location. The distances will be computed between this location and every other | - | | location in the obs list | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``base_type`` | The DART quantity at the ``base_loc`` | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``locs(:)`` | Compute the distance between the ``base_loc`` and each of the locations in this list | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``loc_qtys(:)`` | The corresponding quantity of each item in the ``locs`` list | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``loc_types(:)`` | The corresponding type of each item in the ``locs`` list. This is not available in the default | - | | implementation but may be used in custom implementations. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``num_close`` | The number of items from the ``locs`` list which are within maxdist of the base location | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``close_ind(:)`` | The list of index numbers from the ``locs`` list which are within maxdist of the base location | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``dist(:)`` | If present, return the distance between each entry in the close_ind list and the base location. | - | | If not present, all items in the obs list which are closer than maxdist will be added to the | - | | list but the overhead of computing the exact distances will be skipped. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``state_handle`` | The handle to the state structure containing information about the state vector about which | - | | information is requested. | - +------------------+--------------------------------------------------------------------------------------------------+ - -| - -.. container:: routine - - *call get_close_state(gc, base_loc, base_type, state_loc, state_qtys, state_indx, num_close, close_ind [, dist, - state_handle])* - :: - - type(get_close_type), intent(in) :: gc - type(location_type), intent(inout) :: base_loc - integer, intent(in) :: base_type - type(location_type), intent(inout) :: state_loc(:) - integer, intent(in) :: state_qtys(:) - integer(i8), intent(in) :: state_indx(:) - integer, intent(out) :: num_close - integer, intent(out) :: close_ind(:) - real(r8), optional, intent(out) :: dist(:) - type(ensemble_type), optional, intent(in) :: state_handle - -.. container:: indent1 - - | Given a location and quantity, compute the distances to all other locations in the ``state_loc`` list. The return - values are the number of items which are within maxdist of the base, the index numbers in the original state_loc - list, and optionally the distances. The ``gc`` contains precomputed information to speed the computations. - | In general this is a PASS-THROUGH ROUTINE. It is listed on the use line for the locations_mod, and in the public - list for this module, but has no subroutine declaration and no other code in this module: - - :: - - use location_mod, only: get_close_state - - public :: get_close_state - - However, if the model needs to alter the values or wants to supply an alternative implementation it can intercept the - call like so: - - :: - - use location_mod, only: & - lm_get_close_state => get_close_state - - public :: get_close_state - - In this case a local ``get_close_state()`` routine must be supplied. To call the original code in the location module - use: - - :: - - call loc_get_close_state(gc, base_loc, ...) - - | This subroutine will be called after ``get_close_maxdist_init`` and ``get_close_state_init``. - | In most cases the PASS-THROUGH ROUTINE will be used, but some models need to alter the actual distances depending - on the observation or state vector kind, or based on the observation or state vector location. It is reasonable in - this case to leave ``get_close_maxdist_init()`` and ``get_close_state_init()`` as pass-through routines and - intercept only ``get_close_state()``. The local ``get_close_state()`` can first call the location mod routine and - let it return a list of values, and then inspect the list and alter or remove any entries as needed. See the CAM - and WRF model_mod files for examples of this use. - - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``gc`` | The get_close_type which stores precomputed information about the locations to speed up | - | | searching | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``base_loc`` | Reference location. The distances will be computed between this location and every other | - | | location in the list | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``base_type`` | The DART quantity at the ``base_loc`` | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``state_loc(:)`` | Compute the distance between the ``base_loc`` and each of the locations in this list | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``state_qtys(:)`` | The corresponding quantity of each item in the ``state_loc`` list | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``state_indx(:)`` | The corresponding DART index of each item in the ``state_loc`` list. This is not available in | - | | the default implementation but may be used in custom implementations. | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``num_close`` | The number of items from the ``state_loc`` list which are within maxdist of the base location | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``close_ind(:)`` | The list of index numbers from the ``state_loc`` list which are within maxdist of the base | - | | location | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``dist(:)`` | If present, return the distance between each entry in the ``close_ind`` list and the base | - | | location. If not present, all items in the ``state_loc`` list which are closer than maxdist | - | | will be added to the list but the overhead of computing the exact distances will be skipped. | - +-------------------+-------------------------------------------------------------------------------------------------+ - | ``state_handle`` | The handle to the state structure containing information about the state vector about which | - | | information is requested. | - +-------------------+-------------------------------------------------------------------------------------------------+ - -| - -.. container:: routine - - *call 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(in) :: locs(:) - integer, intent(in) :: loc_qtys(:) - integer, intent(in) :: loc_types(:) - integer, intent(in) :: which_vert - integer, intent(out) :: status(:) - -.. container:: indent1 - - Converts the observations to the desired vertical localization coordinate system. Some models (toy models with no - 'real' observations) will not need this. Most (real) models have observations in one or more coordinate systems - (pressure, height) and the model is generally represented in only one coordinate system. To be able to interpolate - the model state to the observation location, or to compute the true distance between the state and the observation, - it is necessary to convert everything to a single coodinate system. - - +------------------+--------------------------------------------------------------------------------------------------+ - | ``state_handle`` | The handle to the state. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``num`` | the number of observation locations | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``locs`` | the array of observation locations | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``loc_qtys`` | the array of observation quantities. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``loc_types`` | the array of observation types. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``which_vert`` | the desired vertical coordinate system. There is a table in the ``location_mod.f90`` that | - | | relates integers to vertical coordinate systems. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``status`` | Success or failure of the vertical conversion. If ``istatus = 0``, the conversion was a success. | - | | Any other value is a failure. | - +------------------+--------------------------------------------------------------------------------------------------+ - -| - -.. container:: routine - - *call convert_vertical_state(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(in) :: locs(:) - integer, intent(in) :: loc_qtys(:) - integer(i8), intent(in) :: loc_indx(:) - integer, intent(in) :: which_vert - integer, intent(out) :: status(:) - -.. container:: indent1 - - Converts the state to the desired vertical localization coordinate system. Some models (toy models with no 'real' - observations) will not need this. To compute the true distance between the state and the observation, it is necessary - to convert everything to a single coodinate system. - - +------------------+--------------------------------------------------------------------------------------------------+ - | ``state_handle`` | The handle to the state. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``num`` | the number of state locations | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``locs`` | the array of state locations | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``loc_qtys`` | the array of state quantities. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``loc_indx`` | the array of state indices. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``which_vert`` | the desired vertical coordinate system. There is a table in the ``location_mod.f90`` that | - | | relates integers to vertical coordinate systems. | - +------------------+--------------------------------------------------------------------------------------------------+ - | ``status`` | Success or failure of the vertical conversion. If ``istatus = 0``, the conversion was a success. | - | | Any other value is a failure. | - +------------------+--------------------------------------------------------------------------------------------------+ - -| - -.. container:: routine - - *model_time = read_model_time(filename)* - :: - - character(len=*), intent(in) :: filename - type(time_type) :: model_time - -.. container:: indent1 - - Reads the valid time of the model state in a netCDF file. There is a default routine in - ``assimilation_code/modules/io/dart_time_io_mod.f90`` that can be used as a pass-through. That routine will read the - **last** timestep of a 'time' variable - which is the same strategy used for reading netCDF files that have multiple - timesteps in them. If your model has some other representation of time (i.e. it does not use a netCDF variable named - 'time') - you will have to write this routine. - - ============= ==================================== - ``ncid`` handle to an open netCDF file - ``dart_time`` The current time of the model state. - ============= ==================================== - -| - -.. container:: routine - - *call write_model_time(ncid, dart_time)* - :: - - integer, intent(in) :: ncid - type(time_type), intent(in) :: dart_time - -.. container:: indent1 - - Writes the assimilation time to a netCDF file. There is a default routine in - ``assimilation_code/modules/io/dart_time_io_mod.f90`` that can be used as a pass-through. If your model has some - other representation of time (i.e. it does not use a netCDF variable named 'time') - you will have to write this - routine. - - ============= ==================================== - ``ncid`` handle to an open netCDF file - ``dart_time`` The current time of the model state. - ============= ==================================== - -| - -.. container:: routine - - *call end_model()* - -.. container:: indent1 - - Does any shutdown and clean-up needed for model. Can be a NULL INTERFACE if the model has no need to clean up - storage, etc. - -Files ------ - -- Models are free to read and write files as they see fit. - -References ----------- - -#. none - -Private components ------------------- - -N/A From 341bd01da9de644f2130394806d58b7a97120de8 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 30 Jan 2024 15:46:43 -0700 Subject: [PATCH 074/124] Improved rst, some adaptation to code review --- models/aether_lon-lat/readme.rst | 89 ++++++++++++++++++++------------ 1 file changed, 55 insertions(+), 34 deletions(-) diff --git a/models/aether_lon-lat/readme.rst b/models/aether_lon-lat/readme.rst index 37352f2ed8..d7f0670ef7 100644 --- a/models/aether_lon-lat/readme.rst +++ b/models/aether_lon-lat/readme.rst @@ -4,26 +4,30 @@ Aether Rectangular Grid Interface Overview -------- -The Aether ("eether") space weather model (TODO: reference) can be implemented +The `Aether`_ ("eether") space weather model can be implemented on a logically rectangular grid"lon-lat", or on an the cubed-sphere grid (see ../aether_cubed_shere). This is the interface to the lon-lat version. +.. Aether: https://aetherdocumentation.readthedocs.io/en/latest/ + Aether writes history and restart files, with some overlap of the fields (?). The restart fields are divided among 2 types of files: neutrals and ions. They are further divided into "blocks", which are subdomains of the globe. All of these need to be combined to make a single state vector for filter. There's a unique set of these files for each member. The restart file names reflect this information: - {neutrals,ions}_mMMMM_gBBBB.nc - MMMM = ensemble member (0-based) - BBBB = block number (0-based) + +| {neutrals,ions}_mMMMM_gBBBB.nc +| MMMM = ensemble member (0-based) +| BBBB = block number (0-based) + These files do not have grid information in them, which must be read from grid_gBBBB.nc Program aether_to_dart will read a selection of fields from all the restart and grid files for a member and repackage them into an ensemble state vector -(filter_input.nc). +(filter_input.nc), which has a single domain and no halos. Filter will read the ensemble of filter_input.nc files, assimilate, and write an ensemble of filter_output.nc files. @@ -44,14 +48,11 @@ aether_to_dart_nml The Aether fields to be included in the model state are specified in the ``variables`` namelist variable. -The following information must be provided for each field: +The following information must be provided for each field +:: 1) Aether field name -# DART "quantity" to be associated with the field -# max value -# min value -# which file contains the field ("neutrals" or "ions") -# whether the field should be updated in the assimilation +2) which file contains the field ("neutrals" or "ions") Aether field names are not CF-compliant and are translated to CF-compliant forms by aether_to_dart. @@ -59,26 +60,33 @@ The suggested DART quantity to associate with some fields are listed in ./aether_to_dart.nml. The neutrals restart files contain the following fields. -The most important fields are **highlighted**.:: - **Temperature**, **velocity_east**, **velocity_north**, - velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 - -Similarly for the ions restart files: :: - **O+**, **O+_2D**, **O+_2P**, **O2+**, **N2+**, NO+, N+, He+, - Temperature_bulk_ion, Temperature_electron - **NOTE** As of this writing (2024-1-30) the electron density is not available +The most important fields are **highlighted** +:: + +| **Temperature**, **velocity_east**, **velocity_north**, +| velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 + +Similarly for the ions restart files +.. | allows ** to be interpreted as emphasis. +:: + +| **O+**, **O+_2D**, **O+_2P**, **O2+**, **N2+**, NO+, N+, He+, +| Temperature_bulk_ion, Temperature_electron +.. WARNING:: + As of this writing (2024-1-30) the electron density is not available through the restart files, even though electron temperature is. It can be written to the history files. -In addition, there are 7 (independent) fields associated with *each* ion density: +In addition, there are 7 (independent) fields associated with *each* ion density +:: -- Temperature\ \(O+\) -- velocity_parallel_east\ \(O+\) -- velocity_parallel_north\ \(O+\) -- velocity_parallel_up\ \(O+\) -- velocity_perp_east\ \(O+\) -- velocity_perp_north\ \(O+\) -- velocity_perp_up\ \(O+\) + - Temperature\ \(O+\) + - velocity_parallel_east\ \(O+\) + - velocity_parallel_north\ \(O+\) + - velocity_parallel_up\ \(O+\) + - velocity_perp_east\ \(O+\) + - velocity_perp_north\ \(O+\) + - velocity_perp_up\ \(O+\) dart_to_aether_nml @@ -87,20 +95,33 @@ dart_to_aether_nml The ``variables`` in this namelist must match the list in aether_to_dart_nml. Dart_to_aether_nml will convert these fields names to the CF-compliant filter names, find those names in filter_output.nc, and transfer the updated fields -from filter_output.nc to the Aether appropriate restart files. +from filter_output.nc to the appropriate Aether restart files. + +1) Aether field name +2) which file contains the field ("neutrals" or "ions") model_nml ......... -The fields listed in ``variables`` must be the translated names, +:: + +1) Aether field name +#) DART "quantity" to be associated with the field +#) max value +#) min value +#) which file contains the field ("neutrals" or "ions") +#) whether the field should be updated in the assimilation + +The fields listed in ``variables`` must be the *translated* names, as found in the filter_input.nc files. -In general the transformation does the following: +In general the transformation does the following +:: -- Remove all '\', '(', and ')' -- Replace blanks with underscores -- Replace '+' with 'pos' and '-' with 'neg' -- For ions, move the ion name from the end to the beginning. + - Remove all '\', '(', and ')' + - Replace blanks with underscores + - Replace '+' with 'pos' and '-' with 'neg' + - For ions, move the ion name from the end to the beginning. For example 'velocity_parallel_east\ \(O+_2D\)' becomes 'Opos_2D_velocity_parallel_east' From aa92b901fc1ff8d1960ea3775ca84d71263dc5df Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 06:34:31 -0700 Subject: [PATCH 075/124] namelist v11 --- models/aether_lon-lat/work/input.nml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index 88a0a92210..b124cec2af 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -1,3 +1,10 @@ +&probit_transform_nml + / + +&algorithm_info_nml + qceff_table_filename = '' + / + &quality_control_nml / @@ -104,7 +111,6 @@ / &assim_tools_nml - filter_kind = 1 cutoff = 0.2 sort_obs_inc = .false. spread_restoration = .false. From 185b3d720a778f07a30123e0a87edd4df64aeda6 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 06:54:12 -0700 Subject: [PATCH 076/124] chore: add aether executables to gitignore --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 94d5bd9376..ee015c11fa 100644 --- a/.gitignore +++ b/.gitignore @@ -90,6 +90,8 @@ gitm_to_netcdf netcdf_to_gitm_blocks streamflow_obs_diag cam_dart_obs_preprocessor +aether_to_dart +dart_to_aether # Observation converter exectutables convert_aviso From 7037372cc2a3c3732936dbdf9f07350d4b7481e9 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 07:02:39 -0700 Subject: [PATCH 077/124] bug-fix: nc_write_model_atts needs to end define mode and flush buffer --- models/aether_lon-lat/model_mod.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 3ce591e9a2..a81e66b163 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -522,7 +522,10 @@ subroutine nc_write_model_atts(ncid, domain_id) ! TODO Shouldn't the calendar type be defined here? ! It's defined in the time variable = good enough for write_model_time. -! call nc_end_define_mode(ncid) +call nc_end_define_mode(ncid) + +! Flush the buffer and leave netCDF file open +call nc_synchronize_file(ncid) end subroutine nc_write_model_atts From c2fdaf930d11ef11c598709d5efc08451d759bdd Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 07:18:53 -0700 Subject: [PATCH 078/124] remove tiegcm stuff from input.nml also removed stray \ --- models/aether_lon-lat/work/input.nml | 40 ---------------------------- 1 file changed, 40 deletions(-) diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index b124cec2af..f7a6372c4b 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -40,10 +40,6 @@ silence = .false. / -# Example for f10.7 estimation. -# input_state_file_list = 'restart_p_files.txt', 'secondary_files.txt', 'f10.7.txt' -# output_state_file_list = 'out_restart_p_files.txt', 'out_secondary_files.txt', 'out_f10.7.txt' - &filter_nml single_file_in = .false., input_state_files = '' @@ -133,40 +129,6 @@ # 'NO_COPY_BACK' => variable not written to file # all these variables will be updated INTERNALLY IN DART. # -# This is an example of how to restrict the range of each variable -# variables = 'NE', 'QTY_ELECTRON_DENSITY', '1000.0', 'NA', 'restart', 'UPDATE', -# 'TN', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'UPDATE', -# 'TN_NM', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'NO_COPY_BACK', -# 'O1', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.98888', 'restart', 'UPDATE', -# 'O1_NM', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.98888', 'restart', 'NO_COPY_BACK', -# 'O2', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.98888', 'restart', 'UPDATE', -# 'O2_NM', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.98888', 'restart', 'NO_COPY_BACK', -# 'UN', 'QTY_U_WIND_COMPONENT', 'NA', 'NA', 'restart', 'UPDATE', -# 'UN_NM', 'QTY_U_WIND_COMPONENT', 'NA', 'NA', 'restart', 'NO_COPY_BACK', -# 'VN', 'QTY_V_WIND_COMPONENT', 'NA', 'NA', 'restart', 'UPDATE', -# 'VN_NM', 'QTY_V_WIND_COMPONENT', 'NA', 'NA', 'restart', 'NO_COPY_BACK', -# 'OP', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', -# 'TI', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'restart', 'NO_COPY_BACK', -# 'TE', 'QTY_TEMPERATURE_ELECTRON', 'NA', 'NA', 'restart', 'NO_COPY_BACK', -# 'ZG', 'QTY_GEOMETRIC_HEIGHT', 'NA', 'NA', 'secondary', 'NO_COPY_BACK', -# 'f10_7' 'QTY_1D_PARAMETER' 'NA', 'NA', 'calculate', 'UPDATE' -# &model_nml -# debug = 1 -# tiegcm_restart_file_name = 'tiegcm_restart_p.nc' -# tiegcm_secondary_file_name = 'tiegcm_s.nc' -# estimate_f10_7 = .false. -# f10_7_file_name = 'f10_7.nc' -# assimilation_period_seconds = 3600 -# variables = 'NE', 'QTY_ELECTRON_DENSITY', '1000.0', 'NA', 'restart', 'UPDATE' -# 'OP', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', -# 'TI', 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'restart', 'UPDATE', -# 'TE', 'QTY_TEMPERATURE_ELECTRON', 'NA', 'NA', 'restart', 'UPDATE', -# 'OP_NM', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'restart', 'UPDATE', -# 'O1', 'QTY_ATOMIC_OXYGEN_MIXING_RATIO','0.00001', '0.99999', 'restart', 'NO_COPY_BACK', -# 'O2', 'QTY_MOLEC_OXYGEN_MIXING_RATIO', '0.00001', '0.99999', 'restart', 'UPDATE', -# 'TN', 'QTY_TEMPERATURE', '0.0', '6000.0', 'restart', 'UPDATE', -# 'ZG', 'QTY_GEOMETRIC_HEIGHT', 'NA', 'NA', 'secondary', 'NO_COPY_BACK', -# / &model_nml filter_io_filename = 'filter_input_0001.nc' @@ -310,8 +272,6 @@ / - / - # The times in the namelist for the obs_diag program are vectors # that follow the following sequence: # year month day hour minute second From 716d6345eedf856a35f44bdfe5565b7196f7abf2 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 07:35:01 -0700 Subject: [PATCH 079/124] revert quickbuild.rst documenation to main --- guide/quickbuild.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guide/quickbuild.rst b/guide/quickbuild.rst index 47c59b97dc..04cc8678e9 100644 --- a/guide/quickbuild.rst +++ b/guide/quickbuild.rst @@ -68,7 +68,7 @@ For models there are four arrays in quickbuild.sh: ) serial_programs=( - DART programs that do not use mpi go here, but not model_to_dart, dart_to_model + DART programs that do not use mpi go here ) model_programs=( @@ -76,7 +76,7 @@ For models there are four arrays in quickbuild.sh: ) model_serial_programs=( - model programs that do not use mpi go here, e.g. model_to_dart, dart_to_model + model programs that do not use mpi go here ) For observation converters, there is a single array. From 4ed97b485de97378e750ffe4847cac3a5f6ff8db Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 07:36:14 -0700 Subject: [PATCH 080/124] remove aether_cubed-sphere directory. Not used --- models/aether_cubed-sphere/README | 1 - 1 file changed, 1 deletion(-) delete mode 100644 models/aether_cubed-sphere/README diff --git a/models/aether_cubed-sphere/README b/models/aether_cubed-sphere/README deleted file mode 100644 index 5e91ed3f17..0000000000 --- a/models/aether_cubed-sphere/README +++ /dev/null @@ -1 +0,0 @@ -This model will be developed after aether_lon-lat. From a2de034bed3f3214ff8aade14b30a2247c865b17 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 07:37:15 -0700 Subject: [PATCH 081/124] removed dart_gitm_mod copy from aether directory --- .../dart_aether_mod.f90.unneeded | 411 ------------------ 1 file changed, 411 deletions(-) delete mode 100644 models/aether_lon-lat/dart_aether_mod.f90.unneeded diff --git a/models/aether_lon-lat/dart_aether_mod.f90.unneeded b/models/aether_lon-lat/dart_aether_mod.f90.unneeded deleted file mode 100644 index 6da8ce6da3..0000000000 --- a/models/aether_lon-lat/dart_aether_mod.f90.unneeded +++ /dev/null @@ -1,411 +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$ - -module dart_gitm_mod - -! This is the interface between the GITM modules and DART. -! To reduce the possibility of scoping issues, all the -! unrestricted GITM modules are confined to this module. - -use ModConstants -use ModSizeGitm -use ModPlanet - -use typesizes -use netcdf - -use utilities_mod, only : error_handler, E_ERR, E_WARN, E_MSG - -implicit none -private - -! these routines must be public and you cannot change -! the arguments - they will be called *from* the DART code. -public :: get_nLatsPerBlock, & - get_nLonsPerBlock, & - get_nAltsPerBlock, & - get_nSpecies, & - get_nSpeciesTotal, & - get_nIons, & - get_nSpeciesAll, & - decode_gitm_indices - -! 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=256) :: string1, string2 - -contains - -!=================================================================== -! All the public interfaces ... nothing more. -!=================================================================== - -! @todo FIXME - should this now get the sizes from the netcdf file -! and not include GITM code? (i think yes.) - -integer function get_nLatsPerBlock() - get_nLatsPerBlock = nLats -end function get_nLatsPerBlock - -integer function get_nLonsPerBlock() - get_nLonsPerBlock = nLons -end function get_nLonsPerBlock - -integer function get_nAltsPerBlock() - get_nAltsPerBlock = nAlts -end function get_nAltsPerBlock - -integer function get_nSpecies() - get_nSpecies = nSpecies ! From ModPlanet, hopefully -end function get_nSpecies - -integer function get_nSpeciesTotal() - get_nSpeciesTotal = nSpeciesTotal ! From ModPlanet, hopefully -end function get_nSpeciesTotal - -integer function get_nIons() - get_nIons = nIons ! From ModPlanet, hopefully -end function get_nIons - -integer function get_nSpeciesAll() - get_nSpeciesAll = nSpeciesAll ! From ModPlanet, hopefully -end function get_nSpeciesAll - - -subroutine decode_gitm_indices( varname, gitm_varname, gitm_dim, gitm_index, & - long_name, units) -! The rosetta stone relating the user input 'strings' to integer indices. -! -! progvar%varname = varname -! progvar%long_name = long_name -! progvar%units = units -! progvar%gitm_varname = gitm_varname -! progvar%gitm_dim = gitm_dim -! progvar%gitm_index = gitm_index - -character(len=*), intent(in) :: varname -character(len=*), intent(out) :: gitm_varname -integer, intent(out) :: gitm_dim, gitm_index -character(len=NF90_MAX_NAME), intent(out) :: long_name -character(len=NF90_MAX_NAME), intent(out) :: units - - - - long_name = 'something real' - units = 'furlongs/fortnight' - - select case (trim(varname)) - - ! The first hunk of these all come from the NDensityS variable, defined to be: - ! do iSpecies=1,nSpeciesTotal - ! write(iRestartUnit_) NDensityS(:,:,:,iSpecies,iBlock) - ! enddo - - case ('iO_3P_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iO_3P_ - long_name = 'density of O3P molecules' - units = 'mol/m3' - - case ('iO2_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iO2_ - long_name = 'density of O2 molecules' - units = 'mol/m3' - - case ('iN2_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iN2_ - long_name = 'density of N2 molecules' - units = 'mol/m3' - - case ('iN_4S_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iN_4S_ - long_name = 'density of N4S molecules' - units = 'mol/m3' - - case ('iNO_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iNO_ - long_name = 'density of NO molecules' - units = 'mol/m3' - - case ('iN_2D_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iN_2D_ - long_name = 'density of N2D molecules' - units = 'mol/m3' - - case ('iN_2P_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iN_2P_ - long_name = 'density of N2P molecules' - units = 'mol/m3' - - case ('iH_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iH_ - long_name = 'density of H molecules' - units = 'mol/m3' - - case ('iHe_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iHe_ - long_name = 'density of He molecules' - units = 'mol/m3' - - case ('iCO2_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iCO2_ - long_name = 'density of CO2 molecules' - units = 'mol/m3' - - case ('iO_1D_NDensityS') - gitm_varname = 'NDensityS' - gitm_dim = 4 - gitm_index = iO_1D_ - long_name = 'density of O1D molecules' - units = 'mol/m3' - - ! The next hunk of these all pertain to the IDensityS variable: - ! do iSpecies=1,nIons - ! write(iRestartUnit_) IDensityS(:,:,:,iSpecies,iBlock) - ! enddo - - case ('iO_4SP_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iO_4SP_ - long_name = 'density of O4SP ions' - units = 'mol/m3' - - case ('iO2P_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iO2P_ - long_name = 'density of O2P ions' - units = 'mol/m3' - - case ('iN2P_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iN2P_ - long_name = 'density of N2P ions' - units = 'mol/m3' - - case ('iNP_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iNP_ - long_name = 'density of NP ions' - units = 'mol/m3' - - case ('iNOP_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iNOP_ - long_name = 'density of NOP ions' - units = 'mol/m3' - - case ('iO_2DP_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iO_2DP_ - long_name = 'density of O2DP ions' - units = 'mol/m3' - - case ('iO_2PP_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iO_2PP_ - long_name = 'density of O2PP ions' - units = 'mol/m3' - - case ('iHP_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iHP_ - long_name = 'density of HP ions' - units = 'mol/m3' - - case ('iHeP_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = iHeP_ - long_name = 'density of HeP ions' - units = 'mol/m3' - - case ('ie_IDensityS') - gitm_varname = 'IDensityS' - gitm_dim = 4 - gitm_index = ie_ - long_name = 'density of the electrons' - units = 'mol/m3' - - case ('Temperature') ! write(iRestartUnit_) Temperature(:,:,:,iBlock)*TempUnit(:,:,:) - gitm_varname = 'Temperature' - gitm_dim = -1 - gitm_index = -1 - long_name = 'temperature (quantity tied to the square of velocity of the particles)' - units = 'Kelvin' - - case ('ITemperature') ! write(iRestartUnit_) ITemperature(:,:,:,iBlock) - gitm_varname = 'ITemperature' - gitm_dim = -1 - gitm_index = -1 - long_name = 'ion temperature (quantity tied to the square of velocity of the ions)' - units = 'Kelvin' - - case ('eTemperature') ! write(iRestartUnit_) eTemperature(:,:,:,iBlock) - gitm_varname = 'eTemperature' - gitm_dim = -1 - gitm_index = -1 - long_name = 'electron temperature (quantity tied to the square of velocity of the electrons)' - units = 'Kelvin' - - case ('U_Velocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) - gitm_varname = 'Velocity' - gitm_dim = 4 - gitm_index = 1 - long_name = 'the U-component of the velocity of the particles' - units = 'm/s' - - case ('V_Velocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) - gitm_varname = 'Velocity' - gitm_dim = 4 - gitm_index = 2 - long_name = 'the V-component of the velocity of the particles' - units = 'm/s' - - case ('W_Velocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) - gitm_varname = 'Velocity' - gitm_dim = 4 - gitm_index = 3 - long_name = 'the W-component of the velocity of the particles' - units = 'm/s' - - case ('U_IVelocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) - gitm_varname = 'IVelocity' - gitm_dim = 4 - gitm_index = 1 - long_name = 'the U-component of the velocity of the ions' - units = 'm/s' - - case ('V_IVelocity_component') ! write(iRestartUnit_) Velocity(:,:,:,iBlock) - gitm_varname = 'IVelocity' - gitm_dim = 4 - gitm_index = 2 - long_name = 'the V-component of the velocity of the ions' - units = 'm/s' - - case ('W_IVelocity_component') ! write(iRestartUnit_) IVelocity(:,:,:,iBlock) - gitm_varname = 'IVelocity' - gitm_dim = 4 - gitm_index = 3 - long_name = 'the W-component of the velocity of the ions' - units = 'm/s' - - case ('iO_3P_VerticalVelocity') - gitm_varname = 'VerticalVelocity' - gitm_dim = 4 - gitm_index = iO_3P_ - long_name = 'the vertical velocity of the O3P molecule' - units = 'm/s' - - case ('iO2_VerticalVelocity') - gitm_varname = 'VerticalVelocity' - gitm_dim = 4 - gitm_index = iO2_ - long_name = 'the vertical velocity of the O2 molecule' - units = 'm/s' - - case ('iN2_VerticalVelocity') - gitm_varname = 'VerticalVelocity' - gitm_dim = 4 - gitm_index = iN2_ - long_name = 'the vertical velocity of the N2 molecule' - units = 'm/s' - - case ('iN_4S_VerticalVelocity') - gitm_varname = 'VerticalVelocity' - gitm_dim = 4 - gitm_index = iN_4S_ - long_name = 'the vertical velocity of the N4S molecule' - units = 'm/s' - - case ('iNO_VerticalVelocity') - gitm_varname = 'VerticalVelocity' - gitm_dim = 4 - gitm_index = iNO_ - long_name = 'the vertical velocity of the NO molecule' - units = 'm/s' - - case ('iHe_VerticalVelocity') - gitm_varname = 'VerticalVelocity' - gitm_dim = 4 - gitm_index = iHE_ - long_name = 'the vertical velocity of the He molecule' - units = 'm/s' - - case ('TEC') - gitm_varname = 'TEC' - gitm_dim = -1 - gitm_index = -1 - long_name = 'Vertically integrated total electron content' - units = '10^16 electron/m^2' - - case ('f107') ! write(iRestartUnit_) f107_est !Alex !Does DART assume that anything that has gitm_dim = -1 is 3D? - gitm_varname = 'f107' - gitm_dim = -1 - gitm_index = -1 - long_name = 'f107 solar flux index' - units = '1 Solar Flux Unit 10^-22 Wa m^-2 Hz^-1' - - case ('Rho') - gitm_varname = 'Rho' - gitm_dim = -1 - gitm_index = -1 - long_name = 'mass density' - units = 'kg/m3' - - case default - - write(string1,*)'unknown GITM variable '//trim(varname) - call error_handler(E_ERR,'define_var_dims',string1,source,revision,revdate) - - end select - - -end subroutine decode_gitm_indices - - - - -!=================================================================== -! End of dart_gitm_mod -!=================================================================== -end module dart_gitm_mod - -! -! $URL$ -! $Id$ -! $Revision$ -! $Date$ From 9301831a42284f2b83a7575e156fd6bb5c0a7d5f Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 07:42:23 -0700 Subject: [PATCH 082/124] restore clean inside quickbuild.sh if you want to keep the *.o *.mod build a single program: quickbuild.sh filter --- models/aether_lon-lat/work/quickbuild.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/models/aether_lon-lat/work/quickbuild.sh b/models/aether_lon-lat/work/quickbuild.sh index da16690f13..a329e655a7 100755 --- a/models/aether_lon-lat/work/quickbuild.sh +++ b/models/aether_lon-lat/work/quickbuild.sh @@ -44,7 +44,7 @@ buildpreprocess buildit # clean up -# \rm -f -- *.o *.mod +\rm -f -- *.o *.mod } From 298d5b3214e185fe0f712ceb5d2e6e7cb685016b Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 31 Jan 2024 08:32:58 -0700 Subject: [PATCH 083/124] bug-fix: state varaibles were being clamped at max of 0 so all the output Temperature, Ooops was 0. Passing in only the section 1:nvar of the var_ranges array to add_domain added a call to state_structure_info so you can see the clamping options while developing --- models/aether_lon-lat/model_mod.f90 | 8 ++++++-- models/aether_lon-lat/work/input.nml | 8 ++++---- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index a81e66b163..584a00ca71 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -53,7 +53,8 @@ module model_mod use state_structure_mod, only : & add_domain, get_dart_vector_index, get_domain_size, & - get_model_variable_indices, get_varid_from_kind + get_model_variable_indices, get_varid_from_kind, & + state_structure_info use distributed_state_mod, only : get_state @@ -270,7 +271,10 @@ subroutine static_init_model() ! Define which variables are in the model state ! This is using add_domain_from_file (arg list matches) -dom_id = add_domain(filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) +dom_id = add_domain(filter_io_filename, nvar, var_names(1:nvar), var_qtys(1:nvar), var_ranges(1:nvar,:), var_update(1:nvar)) + +call state_structure_info(dom_id) + call init_quad_interp(GRID_QUAD_FULLY_REGULAR, nlon, nlat, & QUAD_LOCATED_CELL_CENTERS, & diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index f7a6372c4b..5be83c911f 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -46,7 +46,7 @@ input_state_file_list = 'filter_inputs.txt' init_time_days = 153131, init_time_seconds = 0, - perturb_from_single_instance = .true., + perturb_from_single_instance = .false., perturbation_amplitude = 0.2, stages_to_write = 'output' @@ -56,7 +56,7 @@ output_state_file_list = 'filter_outputs.txt' output_interval = 1, output_members = .true. - num_output_state_members = 0, + num_output_state_members = 20, output_mean = .true. output_sd = .true. write_all_stages_at_end = .false. @@ -132,8 +132,8 @@ &model_nml filter_io_filename = 'filter_input_0001.nc' - variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'neutrals', 'UPDATE', + 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' time_step_days = 0 time_step_seconds = 3600 debug = 10 From 366e6165bff8eb50a29e36b25efd9e0466eeeb78 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Wed, 31 Jan 2024 09:22:50 -0700 Subject: [PATCH 084/124] minor updates while cleaning up clone --- models/aether_lon-lat/issue_QTYs | 5 +++++ models/aether_lon-lat/model_mod.f90 | 5 ++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/models/aether_lon-lat/issue_QTYs b/models/aether_lon-lat/issue_QTYs index 5cf66a9f0b..96848beb75 100644 --- a/models/aether_lon-lat/issue_QTYs +++ b/models/aether_lon-lat/issue_QTYs @@ -18,6 +18,11 @@ QTY_VELOCITY_W_ION QTY_VERTICAL_VELOCITY or maybe it should have a new QTY like the existing QTY_VELOCITY_VERTICAL_O2: QTY_VELOCITY_PARALLEL_VERTICAL_OP + ^ +Note; the size of these parameters may be limited to 31 (types_mod.f90) + Develop abbreviations? VELOCITY -> VEL + especially for easily recognized words, leaving more characters for + the unusal parts of the names. This last seems safest, since each ion has its own 2 vertical velocities. But I don't know how they'll be used, so maybe a simple, generic QTY for all the ions is fine. diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 584a00ca71..37ea7f398c 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -32,7 +32,7 @@ module model_mod find_namelist_in_file, check_namelist_read, to_upper, & find_enclosing_indices -use obs_kind_mod, only : QTY_GEOMETRIC_HEIGHT +use obs_kind_mod, only : get_index_for_quantity, QTY_GEOMETRIC_HEIGHT use netcdf_utilities_mod, only : & nc_add_global_attribute, nc_synchronize_file, & @@ -49,8 +49,6 @@ module model_mod quad_lon_lat_locate, quad_lon_lat_evaluate, & GRID_QUAD_FULLY_REGULAR, QUAD_LOCATED_CELL_CENTERS -use obs_kind_mod, only : get_index_for_quantity - use state_structure_mod, only : & add_domain, get_dart_vector_index, get_domain_size, & get_model_variable_indices, get_varid_from_kind, & @@ -77,6 +75,7 @@ module model_mod ! TODO: Is nc_write_model_vars no longer mandatory? ! Tiegcm has it listed, but it's just a pass-through to-from default_model_mod ! which has a do-nothing version, and a note "currently unused". +! TODO: Why does this work for aether_to_dart when restart_files_to_netcdf is not in the list? public :: get_model_size, & get_state_meta_data, & model_interpolate, & From 73ec038e3608d6d3ba655d3d1f1120c71ed13c62 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 2 Feb 2024 11:22:05 -0700 Subject: [PATCH 085/124] Moved state transformation procedures out of model_mod Procedures used by only aether_to_dart or dart_to_aether are now in those program files. Procedures shared by them are in a new module; transform_state_mod. The aether_to_dart_nml and dart_to_aether_nml have been replaced by transform_state_nml. The member number is now passed to the programs using a command line argument. These programs compile and appear to run correctly. (model_mod has not been completely updated.) The readme.rst has been updated (but is probably still incomplete). --- models/aether_lon-lat/aether_to_dart.f90 | 477 +++++++++++-- models/aether_lon-lat/aether_to_dart.nml | 40 -- models/aether_lon-lat/dart_to_aether.f90 | 363 +++++++++- models/aether_lon-lat/dart_to_aether.nml | 37 - models/aether_lon-lat/readme.rst | 137 ++-- models/aether_lon-lat/transform_state.nml | 34 + models/aether_lon-lat/transform_state_mod.f90 | 630 ++++++++++++++++++ 7 files changed, 1503 insertions(+), 215 deletions(-) delete mode 100644 models/aether_lon-lat/aether_to_dart.nml delete mode 100644 models/aether_lon-lat/dart_to_aether.nml create mode 100644 models/aether_lon-lat/transform_state.nml create mode 100644 models/aether_lon-lat/transform_state_mod.f90 diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index 6e2e4c2245..71d785d1e7 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -2,95 +2,476 @@ ! by UCAR, "as is", without charge, subject to all terms of use at ! http://www.image.ucar.edu/DAReS/DART/DART_download ! -! $Id$ program aether_to_dart !---------------------------------------------------------------------- -! purpose: interface between the GITM model and DART +! purpose: Transform the Aether model restarts into a DART filter_input.nc. ! ! method: Read aether "restart" files of model state (multiple files, ! one block per aether mpi task) ! Reform fields into a DART netcdf file -! TODO: Should this be an MPI program so that all members can be done at once? -! Get the ensemble size from input.nml:filter_nml. -! Can I send each member to a different node, so that the restart files -! could all be read at once on separate processors, and still be local -! to the member's filter_input.nc? ! ! USAGE: The aether restart dirname and output filename are read from ! the aether_to_dart_nml namelist. ! !---------------------------------------------------------------------- +! Converts Aether restart files to a netCDF file -use types_mod, only : r8 +use types_mod, only : r4, MISSING_I, vtablenamelength -use utilities_mod, only : initialize_utilities, finalize_utilities, & - error_handler, E_MSG +use time_manager_mod, only: time_type -use model_mod, only : restart_files_to_netcdf +use utilities_mod, only : & + finalize_utilities, error_handler, E_ERR, E_MSG, E_WARN, & + initialize_utilities, do_output -implicit none +use default_model_mod, only : write_model_time -character(len=*), parameter :: program_name = 'aether_to_dart' +use transform_state_mod + +use netcdf_utilities_mod, only : & + nc_create_file, nc_close_file, & + nc_begin_define_mode, nc_end_define_mode, & + nc_define_dimension, & + nc_add_global_attribute, nc_add_global_creation_time, & + nc_get_attribute_from_variable, nc_add_attribute_to_variable, & + nc_define_real_variable, nc_define_real_scalar, & + nc_get_variable, nc_put_variable, & + nc_synchronize_file + +implicit none -! !----------------------------------------------------------------------- -! ! namelist parameters with default values. -! !----------------------------------------------------------------------- -! -! character(len=256) :: aether_restart_input_dirname = 'none' -! ! TODO: the calling script will need to move this to a name with $member in it, -! ! or use filter_nml:input_state_file_list -! ! TODO: Create the filter filename from filter_root, as in dart_to_aether. -! character(len=256) :: aether_to_dart_output_file = 'filter_input.nc' -! -! namelist /aether_to_dart_nml/ aether_restart_input_dirname, & -! aether_to_dart_output_file, variables -! !---------------------------------------------------------------------- ! global storage !---------------------------------------------------------------------- -integer :: member +integer :: member = MISSING_I, & + num_args, ncid +character(len=3) :: char_mem +character(len=31) :: filter_io_root = 'filter_input' +character(len=64) :: filter_io_filename = '' +character(len=512) :: error_string_1, error_string_2 +character(len=31), parameter :: progname = 'aether_to_dart' +character(len=256), parameter :: source = 'aether_lon-lat/aether_to_dart.f90' + +character(len=4), parameter :: LEV_DIM_NAME = 'alt' +character(len=4), parameter :: LAT_DIM_NAME = 'lat' +character(len=4), parameter :: LON_DIM_NAME = 'lon' +character(len=4), parameter :: TIME_DIM_NAME = 'time' + +character(len=4), parameter :: LEV_VAR_NAME = 'alt' +character(len=4), parameter :: LAT_VAR_NAME = 'lat' +character(len=4), parameter :: LON_VAR_NAME = 'lon' +character(len=4), parameter :: TIME_VAR_NAME = 'time' !====================================================================== -call initialize_utilities(program_name) +call initialize_utilities(progname) !---------------------------------------------------------------------- ! Get the ensemble member -! TODO: The script must echo the member number to the aether_to_dart. -! TODO: use COMMAND_LINE_ARGUMENT !---------------------------------------------------------------------- -member = -88 -read '(I3)', member -print*,'aether_to_dart: member = ',member +num_args = command_argument_count() +if (num_args == 0) then + write(error_string_1,*) 'Usage: ./aether_to_dart member_number (0-based)' + call error_handler(E_ERR, progname, error_string_1) +endif + +call get_command_argument(1,char_mem) +read(char_mem,'(I3)') member !---------------------------------------------------------------------- ! Convert the files !---------------------------------------------------------------------- -! call error_handler(E_MSG, '', '') -! write(string1,*) 'converting aether restart files in directory ', & -! "'"//trim(aether_restart_input_dirname)//"'" -! write(string2,*) ' to the NetCDF file ', "'"//trim(aether_to_dart_output_file)//"'" -! call error_handler(E_MSG, program_name, string1, text2=string2) -! call error_handler(E_MSG, '', '') +call static_init_blocks() -call restart_files_to_netcdf(member) +! Must be after static_init_blocks, which provides filter_io_root from the namelist. +write(filter_io_filename,'(2A, I0.4, A3)') trim(filter_io_root),'_', member + 1,'.nc' +call error_handler(E_MSG, '', '') +write(error_string_1,'(A,I3,2A)') 'Converting Aether member ',member, & + ' restart files to the NetCDF file ', trim(filter_io_filename) +write(error_string_2,'(3A)') ' in directory ', trim(aether_restart_dirname) +call error_handler(E_MSG, progname, error_string_1, text2=error_string_2) +call error_handler(E_MSG, '', '') -! call error_handler(E_MSG, '', '') -! write(string1,*) 'Successfully converted the GITM restart files to ', & -! "'"//trim(aether_to_dart_output_file)//"'" -! call error_handler(E_MSG, program_name, string1) -! call error_handler(E_MSG, '', '') +! nc_create_file does not leave define mode. +ncid = nc_create_file(filter_io_filename) +! def_fill_dimvars does leave define mode. +call def_fill_dimvars(ncid) -!---------------------------------------------------------------------- -! Finish up -!---------------------------------------------------------------------- +! Write_model_time will make a time variable, if needed, which it is not. +! state_time is read in transform_state_mod and is available by the use statement. +call write_model_time(ncid, state_time) + +! Define (non-time) variables +call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) + +! Read and convert (non-time) variables +call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) +! subr. called by this routine closes the file only if define = .true. +call nc_close_file(ncid) +call error_handler(E_MSG, '', '') +write(error_string_1,'(3A)') 'Successfully converted the Aether restart files to ', & + "'"//trim(filter_io_filename)//"'" +call error_handler(E_MSG, progname, error_string_1) +call error_handler(E_MSG, '', '') + ! end - close the log, etc call finalize_utilities() +!----------------------------------------------------------------------- +contains + +!----------------------------------------------------------------------- +! Open all restart files (blocks x {neutrals,ions}) for 1 member +! and transfer the requested variable contents to the filter input file. +! This is called with 'define' = +! .true. define variables in the file or +! .false. transfer the data from restart files to a filter_inpu.nc file. + +subroutine restarts_to_filter(dirname, ncid_output, member, define) + +character(len=*), intent(in) :: dirname +integer, intent(in) :: ncid_output, member +logical, intent(in) :: define + +integer :: ib, jb, ib_loop, jb_loop + +if (define) then + ! if define, run one block. + ! the block_to_filter_io call defines the variables in the whole domain netCDF file. + ib_loop = 1 + jb_loop = 1 + call nc_begin_define_mode(ncid_output) +else + ! if not define, run all blocks. + ! the block_to_filter_io call adds the (ib,jb) block to the netCDF variables + ! in order to make a file containing the data for all the blocks. + ib_loop = nblocks_lon + jb_loop = nblocks_lat +end if + +do jb = 1, jb_loop + do ib = 1, ib_loop + call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) + enddo +enddo + +if (define) then + call nc_end_define_mode(ncid_output) +endif + +end subroutine restarts_to_filter + +!----------------------------------------------------------------------- +! Transfer variable data from a block restart file to the filter_input.nc file. +! It's called with 2 modes: +! define = .true. define the NC variables in the filter_input.nc +! define = .false. write the data from a block to the NC file using write_filter_io. + +subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) + +integer, intent(in) :: ncid_output +character(len=*), intent(in) :: dirname +integer, intent(in) :: ib, jb +integer, intent(in) :: member +logical, intent(in) :: define + +real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) +! real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) +integer :: ivar, nb, ncid_input +! TEC? integer :: maxsize +! logical :: no_idensity +! real(r4) :: temp0d +character(len=32) :: att_val +character(len=128) :: file_root +character(len=256) :: filename +character(len=vtablenamelength) :: varname, dart_varname + +character(len=*), parameter :: routine = 'block_to_filter_io' + +! The block number, as counted in Aether. +! Lower left is 0, increase to the East, then 1 row farther north, West to East. +nb = (jb - 1) * nblocks_lon + ib - 1 + +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +allocate(temp1d(1-nghost:max(nx_per_block, ny_per_block, nz_per_block) + nghost)) + +! treat alt specially since we want to derive TEC here +! TODO: See density_ion_e too. +! allocate( alt1d(1-nghost:max(nx_per_block, ny_per_block, nz_per_block) + nghost)) + +! temp array large enough to hold any 2D field +allocate(temp2d(1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) + +! TODO: We need all altitudes, but there might be vertical blocks in the future. +! But there would be no vertical halos. +! Make nzcount adapt to whether there are blocks. +! And temp needs to have C-ordering, which is what the restart files have. +! temp array large enough to hold 1 species, temperature, etc +allocate(temp3d(1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) + +! TODO: Waiting for e- guidance from Aaron. +! save density_ion_e to compute TEC +! allocate(density_ion_e(1:nz_per_block, & +! 1-nghost:ny_per_block+nghost, & +! 1-nghost:nx_per_block+nghost)) + +! TODO: Aether gives a unique name to each (of 6) velocity components. +! Do we want to use a temp4d array to handle them? +! They are independent variables in the block files (and state). +! ! temp array large enough to hold velocity vect, etc +! maxsize = max(3, nvar_ion) +! allocate(temp4d(1-nghost:nx_per_block+nghost, & +! 1-nghost:ny_per_block+nghost, & +! 1-nghost:nz_per_block+nghost, maxsize)) + + +! TODO; Does Aether need a replacement for these Density fields? Yes. +! But they are probably read by the loops below. +! Don't need to fetch index because Aether has NetCDF restarts, +! so just loop over the field names to read. +! +! ! assume we could not find the electron density for VTEC calculations +! no_idensity = .true. +! +! if (inum > 0) then +! ! one or more items in the state vector need to replace the +! ! data in the output file. loop over the index list in order. +! j = 1 +! ! TODO: electron density is not in the restart files, but it's needed for TEC +! In Aether they will be from an ions file, but now only from an output file (2023-10-30). +! Can that be handled like the neutrals and ions files, using variables(VT_ORIGININDX,:) +! to build an output file name? Are outputs in block form? +! ! save the electron density for TEC computation +! density_ion_e(:,:,:) = temp3d(:,:,:) + +! Handle the 2 restart file types (ions and neutrals). +! Each field has a file type associated with it: variables(VT_ORIGININDX,f_index) +! TODO: for now require that all neutrals are listed in variables before the ions. + +file_root = variables(VT_ORIGININDX,1) +filename = block_file_name(file_root, member, nb) +ncid_input = open_block_file(filename, 'read') + +do ivar = 1, nvar_neutral + ! The nf90 functions cannot read the variable names with the '\'s in them. + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + if (debug >= 100 .and. do_output()) print*, routine,'varname = ', varname + ! Translate the Aether field name into a CF-compliant DART field name. + dart_varname = aether_name_to_dart(varname) + + ! TODO: Given the subroutine name, perhaps these definition sections should be + ! one call higher up, with the same loop around it. + if (define) then + ! Define the variable in the filter_input.nc file (the output from this program). + ! The calling routine entered define mode. + + if (debug > 10 .and. do_output()) then + write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':', dart_varname + call error_handler(E_MSG, routine, error_string_1, source) + end if + + call nc_define_real_variable(ncid_output, dart_varname, & + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) + call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) + call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units', att_val, routine) + + else if (file_root == 'neutrals') then + ! Read 3D array and extract the non-halo data of this block. +! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. + call nc_get_variable(ncid_input, varname, temp3d, context=routine) + if (debug >= 100 .and. do_output()) then + ! TODO convert to error_handler? Or diagnostics are no longer useful? + print*,'block_to_filter_io: temp3d = ', temp3d(1,1,1), temp3d(15,15,15), varname + print*,'block_to_filter_io: define = ', define + endif + call write_filter_io(temp3d, dart_varname, ib, jb, ncid_output) + else + write(error_string_1,'(A,I3,A)') 'Trying to read neutrals, but variables(', & + VT_ORIGININDX,ivar , ') /= "neutrals"' + call error_handler(E_ERR, routine, error_string_1, source) + endif + +enddo +call nc_close_file(ncid_input) + +file_root = variables(VT_ORIGININDX,nvar_neutral+1) +filename = block_file_name(file_root, member, nb) +ncid_input = open_block_file(filename, 'read') + +do ivar = nvar_neutral +1, nvar_neutral + nvar_ion + ! Purging \ from aether name. + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + dart_varname = aether_name_to_dart(varname) + + if (define) then + + if (debug > 10 .and. do_output()) then + write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':', dart_varname + call error_handler(E_MSG, routine, error_string_1, source) + end if + + call nc_define_real_variable(ncid_output, dart_varname, & + (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) + call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) + call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units', att_val, routine) + print*, routine,': defined ivar, dart_varname, att = ', & + ivar, trim(dart_varname), trim(att_val) + + else if (file_root == 'ions') then + call nc_get_variable(ncid_input, varname, temp3d, context=routine) + call write_filter_io(temp3d, dart_varname, ib, jb, ncid_output) + else + write(error_string_1,'(A,I3,A)') 'Trying to read ions, but variables(', & + VT_ORIGININDX,ivar , ') /= "ions"' + call error_handler(E_ERR, routine, error_string_1, source) + endif + +enddo + +! Leave file open if fields were just added (define = .false.), +! so that time can be added. +if (define) call nc_close_file(ncid_input) + +! TODO: Does Aether need TEC to be calculated? Yes +! ! add the VTEC as an extended-state variable +! ! NOTE: This variable will *not* be written out to the Aether restart files +! +! if (no_idensity) then +! write(error_string_1,*) 'Cannot compute the VTEC without the electron density' +! call error_handler(E_ERR, routine, error_string_1, source) +! end if +! +! temp2d = 0._r8 +! ! compute the TEC integral +! do i =1,nz_per_block-1 ! approximate the integral over the altitude as a sum of trapezoids +! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 +! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * & +! ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 +! end do +! ! convert temp2d to TEC units +! temp2d = temp2d/1e16_r8 +! call write_block_to_filter2d(temp2d, ivals(1), block, ncid, define) + +! TODO: Does Aether need f10_7 to be calculated or processed? Yes +! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') +! call get_index_from_gitm_varname('f107', inum, ivals) +! if (inum > 0) then +! call write_block_to_filter0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine +! endif +! + +deallocate(temp1d, temp2d, temp3d) +! deallocate(alt1d, density_ion_e) + +end subroutine block_to_filter_io + +!----------------------------------------------------------------------- +! Open all restart files (neutrals,ions) for a block and read in the requested data items. +! The write_filter_io calls will write the data to the filter_input.nc. + +subroutine write_filter_io(data3d, varname, ib, jb, ncid) + +real(r4), intent(in) :: data3d(1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost) + +character(len=vtablenamelength), intent(in) :: varname +integer, intent(in) :: ib, jb +integer, intent(in) :: ncid + +integer :: starts(3) + +character(len=*), parameter :: routine = 'write_filter_io' + +! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) + +! to compute the start, consider (ib-1)*nx_per_block+1 +starts(1) = 1 +starts(2) = (jb-1) * ny_per_block + 1 +starts(3) = (ib-1) * nx_per_block + 1 +! TODO: convert to error_msg +! print*, routine,'; starts = ', starts +! print*, routine,'; counts = ', nz_per_block, ny_per_block, nx_per_block,1 + +call nc_put_variable(ncid, varname, & + data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & + context=routine, nc_start=starts, & + nc_count=(/nz_per_block,ny_per_block,nx_per_block/)) +! TODO: convert to error_msg +! print*, routine,': filled varname = ', varname + +end subroutine write_filter_io + +!----------------------------------------------------------------------- +! Add dimension variable contents to the file. + +subroutine def_fill_dimvars(ncid) + +integer, intent(in) :: ncid + +character(len=*), parameter :: routine = 'def_fill_dimvars' + +! File is still in define mode from nc_create_file +! call nc_begin_define_mode(ncid) + +! Global atts for aether_to_dart and dart_to_aether. +call nc_add_global_creation_time(ncid, routine) +call nc_add_global_attribute(ncid, "model_source", source, routine) +call nc_add_global_attribute(ncid, "model", "aether", routine) + +! define grid dimensions +call nc_define_dimension(ncid, trim(LEV_DIM_NAME), nlev, routine) +call nc_define_dimension(ncid, trim(LAT_DIM_NAME), nlat, routine) +call nc_define_dimension(ncid, trim(LON_DIM_NAME), nlon, routine) + +! define grid variables +! z +call nc_define_real_variable( ncid, trim(LEV_VAR_NAME), (/ trim(LEV_DIM_NAME) /), routine) +call nc_add_attribute_to_variable(ncid, trim(LEV_VAR_NAME), 'units', 'm', routine) +call nc_add_attribute_to_variable & + (ncid, trim(LEV_VAR_NAME), 'long_name', 'height above mean sea level', routine) + +! latitude +call nc_define_real_variable( ncid, trim(LAT_VAR_NAME), (/ trim(LAT_DIM_NAME) /), routine) +call nc_add_attribute_to_variable(ncid, trim(LAT_VAR_NAME), 'units', 'degrees_north', routine) +call nc_add_attribute_to_variable(ncid, trim(LAT_VAR_NAME), 'long_name', 'latitude', routine) + +! longitude +call nc_define_real_variable( ncid, trim(LON_VAR_NAME), (/ trim(LON_VAR_NAME) /), routine) +call nc_add_attribute_to_variable(ncid, trim(LON_VAR_NAME), 'units', 'degrees_east', routine) +call nc_add_attribute_to_variable(ncid, trim(LON_VAR_NAME), 'long_name', 'longitude', routine) + +! Dimension 'time' will no longer be created by write_model_time, +! or by nc_define_unlimited_dimension. It will be a scalar variable. +! time +call nc_define_real_scalar( ncid, trim(TIME_VAR_NAME), routine) +call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'calendar', 'gregorian', routine) +call nc_add_attribute_to_variable & + (ncid, trim(TIME_VAR_NAME), 'units', 'days since 1601-01-01 00:00:00', routine) +call nc_add_attribute_to_variable & + (ncid, trim(TIME_VAR_NAME), 'long_name', 'gregorian_days', routine) + +call nc_end_define_mode(ncid) + +call nc_put_variable(ncid, trim(LEV_VAR_NAME), levs, routine) +call nc_put_variable(ncid, trim(LAT_VAR_NAME), lats, routine) +call nc_put_variable(ncid, trim(LON_VAR_NAME), lons, routine) +! time will be written elsewhere. + +! Flush the buffer and leave netCDF file open +call nc_synchronize_file(ncid) + +end subroutine def_fill_dimvars + +!----------------------------------------------------------------------- end program aether_to_dart diff --git a/models/aether_lon-lat/aether_to_dart.nml b/models/aether_lon-lat/aether_to_dart.nml deleted file mode 100644 index b00babb2c2..0000000000 --- a/models/aether_lon-lat/aether_to_dart.nml +++ /dev/null @@ -1,40 +0,0 @@ -&aether_to_dart_nml - aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' - filter_io_root = 'filter_input' - variables = - 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'velocity_east', 'QTY_U_WIND_COMPONENT' '1000.0', 'NA', 'neutrals', 'UPDATE', - 'O+', - 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' - 'Temperature\ \(O+\)', - 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_east\ \(O+\)', - 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_north\ \(O+\)', - 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_up\ \(O+\)', - 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_east\ \(O+\)', - 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_north\ \(O+\)', - 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_up\ \(O+\)', - 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' - debug = 0 - / -! Neutrals from restart files, which Aaron identified as important: - Temperature QTY_TEMPERATURE - velocity_east QTY_U_WIND_COMPONENT - velocity_north QTY_V_WIND_COMPONENT - (velocity_up) QTY_VERTICAL_VELOCITY -! Ions from restart files, which Aaron identified as important: - O+ QTY_DENSITY_ION_OP - O2+ QTY_DENSITY_ION_O2P - O+2D QTY_DENSITY_ION_O2DP ? - O+2P QTY_DENSITY_ION_O2PP ? - N2+ QTY_DENSITY_ION_N2P ? - -See ./issue_QTYs for complete lists of variables and potential QTYs - - diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90 index fc7e9a4aa7..0cabd31749 100644 --- a/models/aether_lon-lat/dart_to_aether.f90 +++ b/models/aether_lon-lat/dart_to_aether.f90 @@ -6,9 +6,9 @@ program dart_to_aether !---------------------------------------------------------------------- -! purpose: interface between DART and the Aether model +! purpose: Transform a DART filter_output.nc into the Aether model restarts. ! -! method: Read DART state netcdf files and overwrite values in Aether restart files. +! method: Read DART state netcdf file and overwrite values in Aether restart files. ! ! this version assumes that the DART grid is global and the data needs to be ! blocked into one block per Aether mpi task. there is a different converter @@ -16,46 +16,367 @@ program dart_to_aether ! !---------------------------------------------------------------------- -use utilities_mod, only : initialize_utilities, finalize_utilities, & - find_namelist_in_file, check_namelist_read, & - E_MSG, error_handler +use types_mod, only : r4, MISSING_I, MISSING_R4, vtablenamelength -use model_mod, only : netcdf_to_restart_files +use utilities_mod, only : & + finalize_utilities, error_handler, E_ERR, E_MSG, E_WARN, & + initialize_utilities, do_output -use time_manager_mod, only : operator(-) +use default_model_mod, only : write_model_time -implicit none +use transform_state_mod + +use netcdf_utilities_mod, only : & + nc_open_file_readonly, nc_close_file, & + nc_begin_define_mode, nc_end_define_mode, & + nc_define_dimension, & + nc_add_global_attribute, nc_add_global_creation_time, & + nc_get_attribute_from_variable, nc_add_attribute_to_variable, & + nc_define_real_variable, nc_define_real_scalar, & + nc_get_variable, nc_put_variable, & + nc_synchronize_file, NF90_FILL_REAL -character(len=*), parameter :: progname = 'dart_to_aether' +implicit none !---------------------------------------------------------------------- ! global storage !---------------------------------------------------------------------- -integer :: member +integer :: member = MISSING_I, & + num_args, ncid +character(len=3) :: char_mem +character(len=31) :: filter_io_root = 'filter_input' +character(len=64) :: filter_io_filename = '' +character(len=512) :: error_string_1, error_string_2 +character(len=31), parameter :: progname = 'dart_to_aether' +character(len=256), parameter :: source = 'aether_lon-lat/dart_to_aether..f90' + +!====================================================================== + +call initialize_utilities(progname) !---------------------------------------------------------------------- ! Get the ensemble member -! TODO: The script must echo the member number to the dart_to_aether. -! There may be a mismatch between member numbers in DART and Aether; F or C indexing. !---------------------------------------------------------------------- -member = -88 -read '(I3)', member -print*,'dart_to_aether: member = ',member - -!====================================================================== +num_args = command_argument_count() +if (num_args == 0) then + write(error_string_1,*) 'Usage: ./dart_to_aether member_number (0-based)' + call error_handler(E_ERR, progname, error_string_1) +endif -call initialize_utilities(progname=progname) +call get_command_argument(1,char_mem) +read(char_mem,'(I3)') member !---------------------------------------------------------------------- -! Reads the valid time, the state, and the target time. +! Convert the files !---------------------------------------------------------------------- -! TODO: netcdf_to_restart_files; need all these file and dir names? -call netcdf_to_restart_files(member) +call static_init_blocks() + +write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member + 1,'.nc' +call error_handler(E_MSG, source, '', '') +write(error_string_1,'(3A)') 'Extracting fields from DART file ',trim(filter_io_filename) +write(error_string_2,'(A,I3,2A)') 'into Aether restart member ',member,' in directory ', trim(aether_restart_dirname) +call error_handler(E_MSG, progname, error_string_1, text2=error_string_2) +call error_handler(E_MSG, '', '') + +ncid = nc_open_file_readonly(filter_io_filename, source) + +call filter_to_restarts(ncid, member) + +!---------------------------------------------------------------------- +! Log what we think we're doing, and exit. +!---------------------------------------------------------------------- +call error_handler(E_MSG, source,'','') +write(error_string_1,'(3A)') 'Successfully converted to the Aether restart files in directory' +write(error_string_2,'(3A)') "'"//trim(aether_restart_dirname)//"'" +call error_handler(E_MSG, source, error_string_1, source, text2=error_string_2) + +call nc_close_file(ncid) + ! end - close the log, etc call finalize_utilities() +!----------------------------------------------------------------------- +contains +!----------------------------------------------------------------------- +! Extract (updated) variables from a filter_output.nc file +! and write to existing block restart files. + +subroutine filter_to_restarts(ncid, member) + +integer, intent(in) :: member, ncid + +real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) +character(len=256) :: file_root +integer :: ivar +character(len=vtablenamelength) :: varname, dart_varname + +character(len=*), parameter :: routine = 'filter_to_restarts' + +! Space for full domain field (read from filter_output.nc) +! and halo around the full domain +allocate(fulldom3d(1:nlev, & + 1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost)) + +! get the dirname, construct the filenames inside open_block_file + +! >>> TODO: Not all fields have halos suitable for calculating gradients. +! These do (2023-11-8): neutrals; temperature, O, O2, N2, and the horizontal winds. +! ions; none. +! The current model_mod will fill all neutral halos anyway, +! since that's simpler and won't break the model. +! TODO: add an attribute to the variables (?) to denote whether a field +! should have its halo filled. +do ivar = 1, nvar_neutral + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + if (debug >= 0 .and. do_output()) then + write(error_string_1,'("varname = ",A)') trim(varname) + call error_handler(E_MSG, routine, error_string_1, source) + endif + dart_varname = aether_name_to_dart(varname) + + file_root = trim(variables(VT_ORIGININDX,ivar)) + if (file_root == 'neutrals') then + ! This parameter is available through the `use netcdf` command. + fulldom3d = NF90_FILL_REAL + + call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & + context=routine) + ! Copy updated field values to full domain halo. + ! Block domains+halos will be easily read from this. + call add_halo_fulldom3d(fulldom3d) + + call filter_io_to_blocks(fulldom3d, varname, file_root, member) + else + ! TODO: error; varname is inconsistent with VT_ORIGININDX + endif + +enddo + +do ivar = nvar_neutral + 1, nvar_neutral + nvar_ion + varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) + dart_varname = aether_name_to_dart(varname) + + file_root = trim(variables(VT_ORIGININDX,ivar)) + if (debug >= 0 .and. do_output()) then + write(error_string_1,'("varname, dart_varname, file_root = ",3(2x,A))') & + trim(varname), trim(dart_varname), file_root + call error_handler(E_MSG, routine, error_string_1, source) + endif + + if (file_root == 'ions') then + fulldom3d = NF90_FILL_REAL + call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & + context=routine) + ! 2023-11: ions do not have real or used data in their halos. + ! Make this clear by leaving the halos filled with MISSING_R4 + ! TODO: Will this be translated into NetCDF missing_value? + ! call add_halo_fulldom3d(fulldom3d) + + call filter_io_to_blocks(fulldom3d, varname, file_root, member) + + else + ! TODO: error; varname is inconsistent with VT_ORIGININDX + endif +enddo + +deallocate(fulldom3d) +!, fulldom1d + +end subroutine filter_to_restarts + + +!----------------------------------------------------------------------- +! Copy updated data from the full domain into the halo regions, +! in preparation for extracting haloed blocks into the block restart files. +! First, the halos past the East and West edges are taken from the wrap-around points. +! Then, the halos beyond the edge latitudes in the North and South +! are taken by reaching over the pole to a longitude that's half way around the globe. +! This is independent of the number of blocks. + +subroutine add_halo_fulldom3d(fulldom3d) + +! Space for full domain field (read from filter_output.nc) +! and halo around the full domain +real(r4), intent(inout) :: fulldom3d(1:nz_per_block, & + 1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost) + +integer :: g, i, j, haflat, haflon +real(r4), allocatable :: normed(:,:) +character(len=16) :: debug_format + +character(len=*), parameter :: routine = 'add_halo_fulldom3d' + +! An array for debugging by renormalizing an altitude of fulldom3d. +allocate(normed(1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost)) + +haflat = nlat / 2 +haflon = nlon / 2 + +do g = 1,nghost + ! left; reach around the date line. + ! There's no data at the ends of the halos for this copy. + fulldom3d (:,1:nlat, 1-g) & + = fulldom3d(:,1:nlat,nlon+1-g) + + ! right + fulldom3d (:,1:nlat,nlon+g) & + = fulldom3d(:,1:nlat,g) + + ! bottom; reach over the S Pole for halo values. + ! There is data at the ends of the halos for these.) + + fulldom3d (:, 1-g ,1-nghost :haflon) & + = fulldom3d(:, g ,1-nghost+haflon:nlon) + fulldom3d (:, 1-g ,haflon+1:nlon) & + = fulldom3d(:, g , 1:haflon) + ! Last 2 (halo) points on the right edge (at the bottom) + fulldom3d (:, 1-g , nlon+1: nlon+nghost) & + = fulldom3d(:, g ,haflon+1:haflon+nghost) + + ! top + fulldom3d (:, nlat +g, 1-nghost :haflon) & + = fulldom3d(:, nlat+1-g, 1-nghost+haflon:nlon) + fulldom3d (:, nlat +g, haflon+1:nlon) & + = fulldom3d(:, nlat+1-g, 1:haflon) + ! Last 2 (halo) points on the right edge (at the top) + fulldom3d (:, nlat +g, nlon+1: nlon+nghost) & + = fulldom3d(:, nlat+1-g, haflon+1:haflon+nghost) +enddo + +if (any(fulldom3d == MISSING_R4)) then + error_string_1 = 'ERROR: some fulldom3d contain MISSING_R4 after halos' + call error_handler(E_ERR, routine, error_string_1, source) +endif + +! TODO: Keep halo corners check for future use? +! Add more robust rescaling. +! Debug; print the 4x4 arrays (corners & middle) +! to see whether values are copied correctly +! Level 44 values range from 800-eps to 805. I don't want to see the 80. +! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. +! 2023-12-20; Aaron sent new files with 54 levels. +if (debug >= 100 .and. do_output()) then + if (fulldom3d(54,10,10) > 1.e+10) then + normed = fulldom3d(54,:,:) - 1.1092e+10 + debug_format = '(3(4E10.4,2X))' + else if (fulldom3d(54,10,10) < 1000._r4) then + normed = fulldom3d(54,:,:) - 800._r4 + debug_format = '(3(4F10.5,2X))' + endif + + ! Debug HDF5 + write(error_string_1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))') normed(nlat+1,nlon+2) + call error_handler(E_MSG, routine, error_string_1, source) + + ! 17 format debug_format + print*,'top' + do j = nlat+2, nlat-1, -1 + write(*,debug_format) (normed(j,i), i= -1, 2), & + (normed(j,i), i=haflon-1,haflon+2), & + (normed(j,i), i= nlon-1, nlon+2) + enddo + print*,'middle' + do j = haflat+2, haflat-1 , -1 + write(*,debug_format) (normed(j,i), i= -1, 2), & + (normed(j,i), i=haflon-1,haflon+2), & + (normed(j,i), i= nlon-1, nlon+2) + enddo + print*,'bottom' + do j = 2,-1, -1 + write(*,debug_format) (normed(j,i), i= -1, 2), & + (normed(j,i), i=haflon-1,haflon+2), & + (normed(j,i), i= nlon-1, nlon+2) + enddo +endif + +deallocate(normed) + +end subroutine add_halo_fulldom3d + +!----------------------------------------------------------------------- +! Transfer part of the full field into a block restart file. + +subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) + +real(r4), intent(in) :: fulldom3d(1:nz_per_block, & + 1-nghost:nlat+nghost, & + 1-nghost:nlon+nghost ) +character(len=*), intent(in) :: varname +character(len=*), intent(in) :: file_root +integer, intent(in) :: member + +! Don't collect velocity components (6 of them) +! real(r4) :: temp0d +! , temp1d(:) ? +integer :: ncid_output +integer :: ib, jb, nb +integer :: starts(3), ends(3), xcount, ycount, zcount +character(len=256) :: block_file + +character(len=*), parameter :: routine = 'filter_io_to_blocks' + +! a temp array large enough to hold any of the +! Lon,Lat or Alt array from a block plus ghost cells +! allocate(temp1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) + +zcount = nz_per_block +ycount = ny_per_block + (2 * nghost) +xcount = nx_per_block + (2 * nghost) + +if (debug > 0 .and. do_output()) then + write(error_string_1,'(A,I0,A,I0,A)') 'Now putting the data for ', nblocks_lon, & + ' blocks lon by ',nblocks_lat,' blocks lat' + call error_handler(E_MSG, routine, error_string_1, source) +end if + +starts(1) = 1 +ends(1) = nz_per_block + +do jb = 1, nblocks_lat + starts(2) = (jb - 1) * ny_per_block - nghost + 1 + ends(2) = jb * ny_per_block + nghost + + do ib = 1, nblocks_lon + starts(3) = (ib - 1) * nx_per_block - nghost + 1 + ends(3) = ib * nx_per_block + nghost + + nb = (jb - 1) * nblocks_lon + ib - 1 + + block_file = block_file_name(trim(file_root), member, nb) + ncid_output = open_block_file(block_file, 'readwrite') + + ! TODO: error checking; does the block file have the field in it? + if ( debug > 0 .and. do_output()) then + write(error_string_1,'(A,3(2X,i5))') "block, ib, jb = ", nb, ib, jb + call error_handler(E_MSG, routine, error_string_1, source) + write(error_string_1,'(3(A,3i5))') & + 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount + call error_handler(E_MSG, routine, error_string_1, source) + endif + + call nc_put_variable(ncid_output, trim(varname), & + fulldom3d(starts(1):ends(1), starts(2):ends(2), starts(3):ends(3)), & + context=routine, nc_count=(/ zcount,ycount,xcount /) ) + + call nc_close_file(ncid_output) + + enddo +enddo + +! +! TODO: ? Add f107 and Rho to the restart files +! call read_filter_io_block0d(ncid, ivals(1), data0d) +! if (data0d < 0.0_r8) data0d = 60.0_r8 !alex +! write(ounit) data0d + +end subroutine filter_io_to_blocks + +!----------------------------------------------------------------------- end program dart_to_aether diff --git a/models/aether_lon-lat/dart_to_aether.nml b/models/aether_lon-lat/dart_to_aether.nml deleted file mode 100644 index 9d734458d4..0000000000 --- a/models/aether_lon-lat/dart_to_aether.nml +++ /dev/null @@ -1,37 +0,0 @@ -&dart_to_aether_nml - aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' - filter_io_root = 'filter_output', - variables = - 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'velocity_east' 'QTY_U_WIND_COMPONENT' '1000.0', 'NA', 'neutrals', 'UPDATE', - 'O+', - 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' - 'Temperature (O+)', - 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_east (O+)', - 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_north (O+)', - 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_up (O+)', - 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_east (O+)', - 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_north (O+)', - 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_up (O+)', - 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' - debug = 0 - / - -! 4 digit member number and .nc will be appended to filter_io_root. - -Neutrals - Temperature, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2, - velocity_east, velocity_north, velocity_up - QTY_[UV]_WIND_COMPONENT, QTY_VERTICAL_VELOCITY - -Ions - O+, O2+, N2+, NO+, N+, He+, O+_2D, O+_2P, ...? - with the same temperature and velocity components as O+ - diff --git a/models/aether_lon-lat/readme.rst b/models/aether_lon-lat/readme.rst index fc83ec4f9d..ac20acc2d3 100644 --- a/models/aether_lon-lat/readme.rst +++ b/models/aether_lon-lat/readme.rst @@ -4,8 +4,8 @@ Aether Rectangular Grid Interface Overview -------- -The `Aether`_ ("eether") space weather model can be implemented -on a logically rectangular grid"lon-lat", +The `Aether` ("eether") space weather model can be implemented +on a logically rectangular grid "lon-lat", or on an the cubed-sphere grid (see ../aether_cubed_shere). This is the interface to the lon-lat version. @@ -14,6 +14,8 @@ This is the interface to the lon-lat version. Aether writes history and restart files, with some overlap of the fields (?). The restart fields are divided among 2 types of files: neutrals and ions. They are further divided into "blocks", which are subdomains of the globe. +Blocks start in the southwest corner of the lat/lon grid and go east first, +then to the west end of the next row north and end in the northeast corner. All of these need to be combined to make a single state vector for filter. There's a unique set of these files for each member. The restart file names reflect this information: @@ -25,15 +27,19 @@ The restart file names reflect this information: These files do not have grid information in them, which must be read from grid_gBBBB.nc -Program aether_to_dart will read a selection of fields from all the restart +Aether_to_dart and dart_to_aether read the same namelist; transform_state_nml. +The fields chosen to be part of the model state are specified in ``variables``. +Program aether_to_dart will read the specified fields from all the restart and grid files for a member and repackage them into an ensemble state vector (filter_input.nc), which has a single domain and no halos. +The field names will be transformed into CF-compliant names in filter_input.nc. Filter will read the ensemble of filter_input.nc files, assimilate, and write an ensemble of filter_output.nc files. -Program dart_to_aether will extract the updated field data from them -and overwrite those fields in the Aether restart files. +Dart_to_aether will convert the fields' names to the CF-compliant filter names, +find those names in filter_output.nc, extract the updated field data, +and overwrite those fields in the appropriate Aether restart files. Namelists --------- @@ -43,80 +49,64 @@ Namelists - Character strings that contain a '/' must be enclosed in quotes to prevent them from prematurely terminating the namelist. -aether_to_dart_nml -..................... +transform_state_nml +................... + + aether_restart_dirname + The directory where the Aether restart files reside, + and will be transformed (the "run" directory). + + nblocks_lon, nblocks_lat, nblocks_lev + Number of Aether domain "blocks" in the longitudinal, latitudinal, + and vertical directions. (vertical is always 1 as of 2024-2) + + variables + The Aether fields to be included in the model state are specified + in the ``variables`` namelist variable in transform_state_nml. + The following information must be provided for each field + + 1) Aether field name + 2) which file contains the field ("neutrals" or "ions") + + Aether field names are not CF-compliant and are translated + to CF-compliant forms by aether_to_dart. + The suggested DART quantity to associate with some fields are listed + in ./aether_to_dart.nml. + + The neutrals restart files contain the following fields. + The most important fields are **highlighted** + + | **Temperature**, **velocity_east**, **velocity_north**, + | velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 + + Similarly for the ions restart files + + | **O+**, **O+_2D**, **O+_2P**, **O2+**, **N2+**, NO+, N+, He+, + | Temperature_bulk_ion, Temperature_electron + + In addition, there are 7 (independent) fields associated with *each* ion density + :: + + - Temperature\ \(O+\) + - velocity_parallel_east\ \(O+\) + - velocity_parallel_north\ \(O+\) + - velocity_parallel_up\ \(O+\) + - velocity_perp_east\ \(O+\) + - velocity_perp_north\ \(O+\) + - velocity_perp_up\ \(O+\) -The Aether fields to be included in the model state are specified -in the ``variables`` namelist variable. -The following information must be provided for each field -:: - -1) Aether field name -2) which file contains the field ("neutrals" or "ions") - -Aether field names are not CF-compliant and are translated -to CF-compliant forms by aether_to_dart. -The suggested DART quantity to associate with some fields are listed -in ./aether_to_dart.nml. - -The neutrals restart files contain the following fields. -The most important fields are **highlighted** -:: - -| **Temperature**, **velocity_east**, **velocity_north**, -| velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 - -Similarly for the ions restart files -.. | allows ** to be interpreted as emphasis. -:: - -| **O+**, **O+_2D**, **O+_2P**, **O2+**, **N2+**, NO+, N+, He+, -| Temperature_bulk_ion, Temperature_electron .. WARNING:: As of this writing (2024-1-30) the electron density is not available through the restart files, even though electron temperature is. It can be written to the history files. - -In addition, there are 7 (independent) fields associated with *each* ion density -:: - - - Temperature\ \(O+\) - - velocity_parallel_east\ \(O+\) - - velocity_parallel_north\ \(O+\) - - velocity_parallel_up\ \(O+\) - - velocity_perp_east\ \(O+\) - - velocity_perp_north\ \(O+\) - - velocity_perp_up\ \(O+\) - - -dart_to_aether_nml -..................... - -The ``variables`` in this namelist must match the list in aether_to_dart_nml. -Dart_to_aether_nml will convert these fields names to the CF-compliant filter names, -find those names in filter_output.nc, and transfer the updated fields -from filter_output.nc to the appropriate Aether restart files. - -1) Aether field name -2) which file contains the field ("neutrals" or "ions") - + model_nml ......... -:: - -1) Aether field name -#) DART "quantity" to be associated with the field -#) max value -#) min value -#) which file contains the field ("neutrals" or "ions") -#) whether the field should be updated in the assimilation - The fields listed in ``variables`` must be the *translated* names, as found in the filter_input.nc files. In general the transformation does the following -:: - Remove all '\', '(', and ')' - Replace blanks with underscores @@ -124,8 +114,17 @@ In general the transformation does the following - For ions, move the ion name from the end to the beginning. For example 'velocity_parallel_east\ \(O+_2D\)' becomes -'Opos_2D_velocity_parallel_east' -:: +'Opos_2D_velocity_parallel_east'. + +The ``variables`` in ``model_nml`` requires more information + + 1) Aether field name + #) DART "quantity" to be associated with the field + #) max value + #) min value + #) >>>>>>>> Fix this in code (filter doesn't need it) + #) which file contains the field ("neutrals" or "ions") + #) whether the field should be updated in the assimilation &model_nml / diff --git a/models/aether_lon-lat/transform_state.nml b/models/aether_lon-lat/transform_state.nml new file mode 100644 index 0000000000..0eea641d76 --- /dev/null +++ b/models/aether_lon-lat/transform_state.nml @@ -0,0 +1,34 @@ +&transform_state_nml + aether_restart_dirname = + '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' + variables = + 'Temperature', 'neutrals', + 'velocity_east', 'neutrals', + 'O+', 'ions', + 'Temperature\ \(O+\)', 'ions', + 'velocity_parallel_east\ \(O+\)', 'ions', + 'velocity_parallel_north\ \(O+\)','ions', + 'velocity_parallel_up\ \(O+\)', 'ions', + 'velocity_perp_east\ \(O+\)', 'ions', + 'velocity_perp_north\ \(O+\)', 'ions', + 'velocity_perp_up\ \(O+\)', 'ions', + nblocks_lon = 2 + nblocks_lat = 2 + nblocks_lev = 1 + debug = 0 + / +! Neutrals from restart files, which Aaron identified as important: + Temperature QTY_TEMPERATURE + velocity_east QTY_U_WIND_COMPONENT + velocity_north QTY_V_WIND_COMPONENT + (velocity_up) QTY_VERTICAL_VELOCITY +! Ions from restart files, which Aaron identified as important: + O+ QTY_DENSITY_ION_OP + O2+ QTY_DENSITY_ION_O2P + O+2D QTY_DENSITY_ION_O2DP ? + O+2P QTY_DENSITY_ION_O2PP ? + N2+ QTY_DENSITY_ION_N2P ? + +See ./issue_QTYs for complete lists of variables and potential QTYs + + diff --git a/models/aether_lon-lat/transform_state_mod.f90 b/models/aether_lon-lat/transform_state_mod.f90 new file mode 100644 index 0000000000..78a0b1ec3b --- /dev/null +++ b/models/aether_lon-lat/transform_state_mod.f90 @@ -0,0 +1,630 @@ +! 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 +! + +module transform_state_mod + +!----------------------------------------------------------------------- +! +! Routines used by aether_to_dart and dart_to_aether +! +!----------------------------------------------------------------------- + +use types_mod, only : & + r4, r8, MISSING_R4, MISSING_R8, vtablenamelength, MISSING_I, RAD2DEG + +use time_manager_mod, only : & + time_type, set_calendar_type, set_time, get_time, set_date, & + print_date, print_time + + +use utilities_mod, only : & + open_file, close_file, file_exist, & + error_handler, E_ERR, E_MSG, E_WARN, & + nmlfileunit, do_output, do_nml_file, do_nml_term, & + find_namelist_in_file, check_namelist_read + +use netcdf_utilities_mod, only : & + nc_open_file_readonly, nc_open_file_readwrite, nc_create_file, & + nc_get_dimension_size, nc_get_variable, & + nc_close_file + +implicit none +private + +public :: static_init_blocks, & + state_time, & + block_file_name, open_block_file, aether_name_to_dart, & + nblocks_lon, nblocks_lat, nblocks_lev, & + lons, lats, levs, & + nlon, nlat, nlev, & + nx_per_block, ny_per_block, nz_per_block, nghost, & + variables, VT_ORIGININDX, VT_VARNAMEINDX, & + nvar, nvar_neutral, nvar_ion, & + aether_restart_dirname, & + purge_chars, debug + +character(len=256), parameter :: source = 'aether_lon-lat/transform_state_mod.f90' + +logical :: module_initialized = .false. + +!----------------------------------------------------------------------- +! namelist parameters with default values. +!----------------------------------------------------------------------- + +character(len=256) :: aether_restart_dirname = 'none' +! An ensemble of file names is created using this root and $member in it, + +integer, parameter :: MAX_STATE_VARIABLES = 100 +integer, parameter :: NUM_STATE_TABLE_COLUMNS = 2 +character(len=vtablenamelength) :: variables(NUM_STATE_TABLE_COLUMNS,MAX_STATE_VARIABLES) = ' ' + +! number of blocks along each dim +integer :: nblocks_lon=MISSING_I, nblocks_lat=MISSING_I, nblocks_lev=MISSING_I +! These are not used in DA, and lon_start is used only for 1D modeling +! real(r8) :: lat_start =MISSING_I, lat_end =MISSING_I, lon_start=MISSING_I + +integer :: debug = 0 + +namelist /transform_state_nml/ aether_restart_dirname, variables, debug, & + nblocks_lon, nblocks_lat, nblocks_lev + +!----------------------------------------------------------------------- +! Dimensions + +! To be assigned get_grid_from_blocks (aether_to_dart, dart_to_aether). +integer :: nlev, nlat, nlon +real(r8), allocatable :: levs(:), lats(:), lons(:) + +! Aether block parameters (nblocks_{lon,lat,lev} are read from a namelist) +integer :: nx_per_block, ny_per_block, nz_per_block + +integer, parameter :: nghost = 2 ! number of ghost cells on all edges + +!----------------------------------------------------------------------- +! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table +! VT_ORIGININDX is used differently from the usual domains context. +integer, parameter :: VT_VARNAMEINDX = 1 ! ... variable name +integer, parameter :: VT_ORIGININDX = 2 ! file of origin + +!----------------------------------------------------------------------- +! Day 0 in Aether's calendar is (+/1 a day) -4710/11/24 0 UTC +! integer :: aether_ref_day = 2451545 ! cJULIAN2000 in Aether = day of date 2000/01/01. +character(len=32) :: calendar = 'GREGORIAN' + +! But what we care about is the ref time for the times in the files, which is 1965-1-1 00:00 +integer, dimension(:) :: aether_ref_date(5) = (/1965,1,1,0,0/) ! y,mo,d,h,m (secs assumed 0) +type(time_type) :: aether_ref_time, state_time +integer :: aether_ref_ndays, aether_ref_nsecs + +!----------------------------------------------------------------------- +! to be assigned in the verify_variables subroutine +integer :: nvar, nvar_neutral, nvar_ion + +!----------------------------------------------------------------------- +character(len=512) :: error_string_1, error_string_2 + +contains + +!----------------------------------------------------------------------- +! Like static_init_model, but for aether_to_dart and dart_to_aether. +! Read the namelist, +! parse the 'variables' table, +! get the Aether grid information +! convert the Aether time into a DART time. + +subroutine static_init_blocks() + +character(len=128) :: aether_filter_io_filename +integer :: iunit, io + +character(len=*), parameter :: routine = 'static_init_blocks' + +if (module_initialized) return ! only need to do this once + +! This prevents subroutines called from here from calling static_init_mod. +module_initialized = .true. + +!------------------ +! Read the namelist + +call find_namelist_in_file("input.nml", 'transform_state_nml', iunit) +read(iunit, nml = transform_state_nml, iostat = io) +! Record the namelist values used for the run +if (do_nml_file()) write(nmlfileunit, nml=transform_state_nml) +if (do_nml_term()) write( * , nml=transform_state_nml) +call check_namelist_read(iunit, io, 'transform_state_nml') ! closes, too. + + +! error-check, convert namelist input to arrays. +! 'variables' comes from the namelist in input.nml +! TODO: we haven't settled on the mechanism for identifying the state vector field names and source. +! (defined type, arrays, named indices,...) +! After splitting a2d and d2a routines out of model_mod, they can't use +! the model_mod:verify_variables. This calls a new one. +call verify_variables(variables) + +!-------------------------------- +! TODO: Set the time step +! Ensures model_advance_time is multiple of 'dynamics_timestep' + +! Aether uses Julian time internally, andor a Julian calendar +! (days from the start of the calendar), depending on the context) +call set_calendar_type( calendar ) + +!-------------------------------- +! 1) get grid dimensions +! 2) allocate space for the grids +! 3) read them from the block restart files, could be stretched ... +! Opens and closes the grid block file, but not the filter netcdf file. +call get_grid_from_blocks(aether_restart_dirname) + +if( debug > 0 ) then + write(error_string_1,'(A,3I5)') 'grid dims are ', nlon, nlat, nlev + call error_handler(E_MSG, routine, error_string_1, source) +endif + +! Convert the Aether reference date (not calendar day = 0 date) +! to the days and seconds of the calendar set in model_mod_nml. +aether_ref_time = set_date(aether_ref_date(1), aether_ref_date(2), aether_ref_date(3), & + aether_ref_date(4), aether_ref_date(5)) +call get_time(aether_ref_time, aether_ref_nsecs, aether_ref_ndays) + +! Get the model time from a restart file. +aether_filter_io_filename = block_file_name(variables(VT_ORIGININDX,1), 0, 0) +state_time = read_aether_time(trim(aether_restart_dirname)//'/'//trim(aether_filter_io_filename)) + +if ( debug > 0 ) then + write(error_string_1,'("grid: nlon, nlat, nlev =",3(1x,i5))') nlon, nlat, nlev + call error_handler(E_MSG, routine, error_string_1, source) +endif + +end subroutine static_init_blocks + +!----------------------------------------------------------------------- +! Parse the table of variables' characteristics. + +subroutine verify_variables(variables) + +character(len=*), intent(in) :: variables(:,:) + +character(len=vtablenamelength) :: varname, rootstr +integer :: i + +character(len=*), parameter :: routine = 'verify_variables' + +nvar = 0 +MY_LOOP : do i = 1, size(variables,2) + + varname = variables(VT_VARNAMEINDX,i) + rootstr = variables(VT_ORIGININDX,i) + + if ( varname == ' ' .and. rootstr == ' ' ) exit MY_LOOP ! Found end of list. + + if ( varname == ' ' .or. rootstr == ' ' ) then + error_string_1 = 'model_nml: variable list not fully specified' + call error_handler(E_ERR, routine, error_string_1, source) + endif + + ! The internal DART routines check if the variable name is valid. + + ! All good to here - fill the output variables + + nvar = nvar + 1 + if (variables(VT_ORIGININDX,i) == 'neutrals') nvar_neutral = nvar_neutral + 1 + if (variables(VT_ORIGININDX,i) == 'ions') nvar_ion = nvar_ion + 1 + + +enddo MY_LOOP + +if (nvar == MAX_STATE_VARIABLES) then + error_string_1 = 'WARNING: you may need to increase "MAX_STATE_VARIABLES"' + write(error_string_2,'(''you have specified at least '',i4,'' perhaps more.'')') nvar + call error_handler(E_MSG, routine, error_string_1, source, text2=error_string_2) +endif + +end subroutine verify_variables + +!----------------------------------------------------------------------- +! ? Will this need to open the grid_{below,corners,down,left} filetypes? +! This code can handle it; a longer filetype passed in, and no member. +! ? Aether output files? + +function block_file_name(filetype, memnum, blocknum) + +character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} +integer, intent(in) :: blocknum +integer, intent(in) :: memnum +character(len=128) :: block_file_name + +character(len=*), parameter :: routine = 'block_file_name' + +block_file_name = trim(filetype) +if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum +if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum +block_file_name = trim(block_file_name)//'.nc' +if ( debug > 0 ) then + write(error_string_1,'("filename, memnum, blocknum = ",A,2(1x,i5))') & + trim(block_file_name), memnum, blocknum + call error_handler(E_MSG, routine, error_string_1, source) +endif + +end function block_file_name + +!----------------------------------------------------------------------- +! Read block grid values (2D arrays) from a grid NetCDF file. +! Allocate and fill the full-domain 1-D dimension arrays (lon, lat, levs) + +! This routine needs: +! +! 1. A base dirname for the restart files (aether_restart_dirname). +! The filenames have the format 'dirname/{neutrals,ions}_mMMMM_gBBBB.rst' +! where BBBB is the block number, MMMM is the member number, +! and they have leading 0s. Blocks start in the +! southwest corner of the lat/lon grid and go east first, +! then to the west end of the next row north and end in the northeast corner. +! +! In the process, the routine will find: +! +! 1. The number of blocks in Lon and Lat (nblocks_lon, nblocks_lat) +! +! 2. The number of lons and lats in a single grid block (nx_per_block, ny_per_block, nz_per_block) +! +! 3. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. +! +! 4. The number of neutral species (and probably a mapping between +! the species number and the variable name) (nvar_neutral) +! +! 5. The number of ion species (ditto - numbers <-> names) (nvar_ion) +! +! In addition to reading in the state data, it fills Longitude, Latitude, and Altitude arrays. +! This grid is orthogonal and rectangular but can have irregular spacing along +! any of the three dimensions. + +subroutine get_grid_from_blocks(dirname) + +character(len=*), intent(in) :: dirname + +integer :: nb, offset, ncid, nboff +integer :: starts(3), ends(3), xcount, ycount, zcount +character(len=128) :: filename +real(r4), allocatable :: temp(:,:,:) + +character(len=*), parameter :: routine = 'get_grid_from_blocks' + +! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), +! in order to calculate the n[xyz]_per_block dimensions. +! grid_g0000.nc looks like a worthy candidate, but a restart could be used. +write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' +ncid = nc_open_file_readonly(filename, routine) + +! The grid (and restart) file variables have halos, so strip them off +! to get the number of actual data values in each dimension of the block. +nx_per_block = nc_get_dimension_size(ncid, 'x', routine) - (2 * nghost) +ny_per_block = nc_get_dimension_size(ncid, 'y', routine) - (2 * nghost) +nz_per_block = nc_get_dimension_size(ncid, 'z', routine) + +nlon = nblocks_lon * nx_per_block +nlat = nblocks_lat * ny_per_block +nlev = nblocks_lev * nz_per_block + +write(error_string_1,'(3(A,I5))') 'nlon = ', nlon, 'nlat = ', nlat, 'nlev = ', nlev +call error_handler(E_MSG, routine, error_string_1, source) + +! TODO; do these need to be deallocated somewhere? +! Probably not; this is only done once, and these arrays are needed +! through most of the a2d and d2a programs. +allocate( lons( nlon )) +allocate( lats( nlat )) +allocate( levs( nlev )) + +if (debug > 4) then + write(error_string_1,'(2A)') 'Successfully read Aether grid file:', trim(filename) + call error_handler(E_MSG, routine, error_string_1, source) + write(error_string_1,'(A,I5)') ' nx_per_block:', nx_per_block, & + ' ny_per_block:', ny_per_block, ' nz_per_block:', nz_per_block + call error_handler(E_MSG, routine, error_string_1, source) +endif + +! A temp array large enough to hold any of the 3D +! Lon, Lat or Alt arrays from a block plus ghost cells. +! The restart files have C-indexing (fastest changing dim is the last). +allocate(temp( 1:nz_per_block, & + 1-nghost:ny_per_block+nghost, & + 1-nghost:nx_per_block+nghost)) +temp = MISSING_R4 + +starts(1) = 1 - nghost +starts(2) = 1 - nghost +starts(3) = 1 +ends(1) = nx_per_block + nghost +ends(2) = ny_per_block + nghost +ends(3) = nz_per_block +xcount = nx_per_block + (2 * nghost) +ycount = ny_per_block + (2 * nghost) +zcount = nz_per_block +if ( debug > 0 ) then + write(error_string_1,'(2(A,3i5),A,3(1X,i5))') & + 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount + call error_handler(E_MSG, routine, error_string_1, source) +endif + +! go across the south-most block row picking up all longitudes +do nb = 1, nblocks_lon + + ! filename is trimmed by passage to open_block_file + "len=*" there. + filename = block_file_name('grid', -1, nb-1) + ncid = open_block_file(filename, 'read') + + ! Read 3D array and extract the longitudes of the non-halo data of this block. + ! The restart files have C-indexing (fastest changing dim is the last), + ! So invert the dimension bounds. + call nc_get_variable(ncid, 'Longitude', & + temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & + context=routine, & + nc_count=(/ zcount,ycount,xcount /)) + + offset = (nx_per_block * (nb - 1)) + lons(offset+1:offset+nx_per_block) = temp(1,1,1:nx_per_block) + + call nc_close_file(ncid) +enddo + +! go up west-most block row picking up all latitudes +do nb = 1, nblocks_lat + + ! Aether's block name counter start with 0, but the lat values can come from + ! any lon=const column of blocks. + nboff = ((nb - 1) * nblocks_lon) + filename = block_file_name('grid', -1, nboff) + ncid = open_block_file(filename, 'read') + + call nc_get_variable(ncid, 'Latitude', & + temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & + context=routine, nc_count=(/zcount,ycount,xcount/)) + + + offset = (ny_per_block * (nb - 1)) + lats(offset+1:offset+ny_per_block) = temp(1,1:ny_per_block,1) + + call nc_close_file(ncid) +enddo + + +! this code assumes all columns share the same altitude array, +! so we can read it from the first block. +! if this is not the case, this code has to change. + +filename = block_file_name('grid', -1, 0) +ncid = open_block_file(filename, 'read') + +temp = MISSING_R8 +call nc_get_variable(ncid, 'Altitude', & + temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & + context=routine, nc_count=(/zcount,ycount,xcount/)) + +levs(1:nz_per_block) = temp(1:nz_per_block,1,1) + +call nc_close_file(ncid) + +deallocate(temp) + +! convert from radians into degrees +lons = lons * RAD2DEG +lats = lats * RAD2DEG + +if (debug > 4) then + print *, routine, 'All lons ', lons + print *, routine, 'All lats ', lats + print *, routine, 'All levs ', levs +endif + +if ( debug > 1 ) then ! Check dimension limits + write(error_string_1,'(A,2F15.4)') 'LON range ', minval(lons), maxval(lons) + call error_handler(E_MSG, routine, error_string_1, source) + write(error_string_1,'(A,2F15.4)') 'LAT range ', minval(lats), maxval(lats) + call error_handler(E_MSG, routine, error_string_1, source) + write(error_string_1,'(A,2F15.4)') 'ALT range ', minval(levs), maxval(levs) + call error_handler(E_MSG, routine, error_string_1, source) +endif + +end subroutine get_grid_from_blocks + +!----------------------------------------------------------------------- +! Read the Aether restart file time and convert to a DART time. + +function read_aether_time(filename) +type(time_type) :: read_aether_time +character(len=*), intent(in) :: filename + +integer :: ncid +integer :: tsimulation ! the time read from a restart file; seconds from aether_ref_date. +integer :: ndays, nsecs + +character(len=*), parameter :: routine = 'read_aether_time' + +tsimulation = MISSING_I + +ncid = open_block_file(filename, 'read') +call nc_get_variable(ncid, 'time', tsimulation, context=routine) +call nc_close_file(ncid, routine, filename) + +! Calculate the DART time of the file time. +! TODO: review calculation of ndays in read_aether_time +ndays = tsimulation / 86400 +nsecs = tsimulation - (ndays * 86400) +! The ref day is not finished, but don't need to subtract 1 because +! that was accounted for in the integer calculation of ndays. +ndays = aether_ref_ndays + ndays +read_aether_time = set_time(nsecs, ndays) + +if (do_output()) & + call print_time(read_aether_time, routine//': time in restart file '//filename) +if (do_output()) & + call print_date(read_aether_time, routine//': date in restart file '//filename) + +if (debug > 8) then + write(error_string_1,'(A,I5)')'tsimulation ', tsimulation + call error_handler(E_MSG, routine, error_string_1, source) + write(error_string_1,'(A,I5)')'ndays ', ndays + call error_handler(E_MSG, routine, error_string_1, source) + write(error_string_1,'(A,I5)')'nsecs ', nsecs + call error_handler(E_MSG, routine, error_string_1, source) + + call print_date(aether_ref_time, routine//':model base date') + call print_time(aether_ref_time, routine//':model base time') +endif + +end function read_aether_time + +!----------------------------------------------------------------------- +! Convert Aether's non-CF-compliant names into CF-compliant names for filter. +! For the ions, it moves the name of the ion from the end of the variable names +! to the beginning. + +function aether_name_to_dart(varname) + +character(len=vtablenamelength), intent(in) :: varname + +character(len=vtablenamelength) :: aether_name_to_dart, aether +character(len=64) :: parts(8), var_root +integer :: char_num, first, i_parts, aether_len, end_str + +aether = trim(varname) +aether_len = len_trim(varname) +parts = '' + +! Look for the last ' '. The characters after that are the species. +! If there's no ' ', the whole string is the species. +char_num = 0 +char_num = scan(trim(aether),' ', back=.true.) +var_root = aether(char_num+1:aether_len) +! purge_chars removes unwanted [()\] +parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) +! TODO: keep aether_name_to_dart diagnostic? Then add routine, error_handler. +! print*,'var_root, parts(1) = ', var_root, parts(1) +end_str = char_num + +! Tranform remaining pieces of varname into DART versions. +char_num = MISSING_I +first = 1 +i_parts = 2 +P_LOOP: do + ! This returns the position of the first blank *within the substring* passed in. + char_num = scan(aether(first:end_str),' ', back=.false.) + if (char_num > 0 .and. first < aether_len) then + parts(i_parts) = purge_chars(aether(first:first+char_num-1), '.)(\', plus_minus=.true.) + + first = first + char_num + i_parts = i_parts + 1 + else + exit P_LOOP + endif +enddo P_LOOP + +! Construct the DART field name from the parts +aether_name_to_dart = trim(parts(1)) +i_parts = 2 +Build : do + if (trim(parts(i_parts)) /= '') then + aether_name_to_dart = trim(aether_name_to_dart)//'_'//trim(parts(i_parts)) + i_parts = i_parts + 1 + else + exit Build + endif +enddo Build + +end function aether_name_to_dart + +!----------------------------------------------------------------------- +! Replace undesirable characters with better. + +function purge_chars(ugly_string, chars, plus_minus) + +character (len=*), intent(in) :: ugly_string, chars +logical, intent(in) :: plus_minus +character (len=64) :: purge_chars + +character (len=256) :: temp_str + +integer :: char_num, end_str, pm_num + +! Trim is not needed here +temp_str = ugly_string +end_str = len_trim(temp_str) +char_num = MISSING_I +Squeeze : do + ! Returns 0 if chars are not found + char_num = scan(temp_str, chars) + ! Need to change it to a char that won't be found by scan in the next iteration, + ! and can be easily removed. + if (char_num > 0) then + ! Squeeze out the character + temp_str(char_num:end_str-1) = temp_str(char_num+1:end_str) + temp_str(end_str:end_str) = '' +! temp_str(char_num:char_num) = ' ' + else + exit Squeeze + endif +enddo Squeeze + +! Replace + and - with pos and neg. Assume there's only 1. +temp_str = trim(adjustl(temp_str)) +end_str = len_trim(temp_str) +pm_num = scan(trim(temp_str),'+-', back=.false.) +if (pm_num == 0 .or. .not. plus_minus) then + purge_chars = trim(temp_str) +else + if (temp_str(pm_num:pm_num) == '+') then + purge_chars = temp_str(1:pm_num-1)//'pos' + else if (temp_str(pm_num:pm_num) == '-') then + purge_chars = temp_str(1:pm_num-1)//'neg' + endif + if (pm_num + 1 <= end_str) & + purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) +endif + +end function purge_chars + +!----------------------------------------------------------------------- +! Open an Aether restart block file (neutral, ion, ...?) + +function open_block_file(filename, rw) + +! filename is trimmed by this definition +character(len=*), intent(in) :: filename +character(len=*), intent(in) :: rw ! 'read' or 'readwrite' +integer :: open_block_file + +character(len=*), parameter :: routine = 'open_block_file' + +if ( .not. file_exist(filename) ) then + write(error_string_1,'(4A)') 'cannot open file ', filename,' for ', rw + call error_handler(E_ERR, routine, error_string_1, source) +endif + +if (debug > 0) then + write(error_string_1,'(4A)') 'Opening file ', trim(filename), ' for ', rw + call error_handler(E_MSG, routine, error_string_1, source) +end if + + +if (rw == 'read') then + open_block_file = nc_open_file_readonly(filename, routine) +else if (rw == 'readwrite') then + open_block_file = nc_open_file_readwrite(filename, routine) +else + error_string_1 = ': must be called with rw={read,readwrite}, not '//rw + call error_handler(E_ERR, routine, error_string_1, source) +endif + + +if (debug > 80) then + write(error_string_1,'(4A)') 'Returned file descriptor is ', open_block_file + call error_handler(E_MSG, routine, error_string_1, source) +end if + +end function open_block_file + +end module transform_state_mod From aff261853ad4d3ce30426fb39797a517321301ef Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 2 Feb 2024 12:52:55 -0700 Subject: [PATCH 086/124] Removed state transformation routines and related variables It still uses the 2D 'variables' array. It compiles and passes model_mod_check tests 1-5,7. --- models/aether_lon-lat/model_mod.f90 | 1479 +-------------------------- models/aether_lon-lat/model_mod.nml | 21 +- 2 files changed, 21 insertions(+), 1479 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 37ea7f398c..8dbc584ba0 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -12,11 +12,10 @@ module model_mod !----------------------------------------------------------------------- use types_mod, only : & - r4, r8, i8, MISSING_R4, MISSING_R8, vtablenamelength, MISSING_I, RAD2DEG + r8, i8, MISSING_R8, vtablenamelength use time_manager_mod, only : & - time_type, set_calendar_type, set_time, get_time, set_date, & - print_date, print_time + time_type, set_calendar_type, set_time use location_mod, only : & location_type, get_close_type, & @@ -26,9 +25,9 @@ module model_mod VERTISHEIGHT, query_location, get_location use utilities_mod, only : & - open_file, close_file, file_exist, register_module, & + open_file, close_file, & error_handler, E_ERR, E_MSG, E_WARN, & - nmlfileunit, do_output, do_nml_file, do_nml_term, & + nmlfileunit, do_nml_file, do_nml_term, & find_namelist_in_file, check_namelist_read, to_upper, & find_enclosing_indices @@ -39,10 +38,7 @@ module model_mod nc_add_global_creation_time, & nc_begin_define_mode, nc_end_define_mode, & nc_open_file_readonly, nc_get_dimension_size, nc_create_file, & - nc_close_file, nc_get_variable, nc_define_dimension, & - nc_define_real_variable, nc_define_real_scalar, nc_open_file_readwrite, & - nc_add_attribute_to_variable, nc_put_variable, & - nc_get_attribute_from_variable, NF90_FILL_REAL + nc_get_variable use quad_utils_mod, only : & quad_interp_handle, init_quad_interp, set_quad_coords, & @@ -75,7 +71,6 @@ module model_mod ! TODO: Is nc_write_model_vars no longer mandatory? ! Tiegcm has it listed, but it's just a pass-through to-from default_model_mod ! which has a do-nothing version, and a note "currently unused". -! TODO: Why does this work for aether_to_dart when restart_files_to_netcdf is not in the list? public :: get_model_size, & get_state_meta_data, & model_interpolate, & @@ -94,10 +89,6 @@ module model_mod shortest_time_between_assimilations, & write_model_time -public :: restart_files_to_netcdf, & - netcdf_to_restart_files, & - block_file_name - character(len=256), parameter :: source = 'aether_lon-lat/model_mod.f90' logical :: module_initialized = .false. @@ -120,38 +111,18 @@ module model_mod ! This module uses vtablenamelength instead (which is shorter = less white space output ! to diagnostics). integer, parameter :: MAX_STATE_VARIABLES = 100 -integer, parameter :: NUM_STATE_TABLE_COLUMNS = 6 +integer, parameter :: NUM_STATE_TABLE_COLUMNS = 5 character(len=vtablenamelength) :: variables(NUM_STATE_TABLE_COLUMNS,MAX_STATE_VARIABLES) = ' ' namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables -!----------------------------------------------------------------------- -! aether_to_dart namelist parameters with default values. -!----------------------------------------------------------------------- - -character(len=256) :: aether_restart_dirname = 'none' -! An ensemble of file names is created using this root and $member in it, -character (len = vtablenamelength) :: filter_io_root = 'filter_input' - -namelist /aether_to_dart_nml/ aether_restart_dirname, filter_io_root, variables, debug - -! dart_to_aether namelist parameters with default values. -!----------------------------------------------------------------------- - -namelist /dart_to_aether_nml/ aether_restart_dirname, filter_io_root, variables, debug - !----------------------------------------------------------------------- ! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table -! VT_ORIGININDX is used differently from the usual domains context. -! It does not provide full path+filenames. Here it is used by aether_to_dart and -! dart_to_aether to identify whether a variable comes from a neutrals or ions block file. -! It is not used by filter's definition of a domain. integer, parameter :: VT_VARNAMEINDX = 1 ! ... variable name integer, parameter :: VT_KINDINDX = 2 ! ... DART kind integer, parameter :: VT_MINVALINDX = 3 ! ... minimum value if any integer, parameter :: VT_MAXVALINDX = 4 ! ... maximum value if any -integer, parameter :: VT_ORIGININDX = 5 ! file of origin -integer, parameter :: VT_STATEINDX = 6 ! ... update (state) or not +integer, parameter :: VT_STATEINDX = 5 ! ... update (state) or not !----------------------------------------------------------------------- ! Dimensions @@ -172,40 +143,17 @@ module model_mod character(len=4), parameter :: LON_VAR_NAME = 'lon' character(len=4), parameter :: TIME_VAR_NAME = 'time' -! Aether -! number of blocks along each dim -integer :: nblocks_lon=MISSING_I, nblocks_lat=MISSING_I, nblocks_lev=MISSING_I -integer :: nx_per_block, ny_per_block, nz_per_block - -! TODO: should nghost be read from the namelist? -! Aaron; not in the foreseeable future. -integer, parameter :: nghost = 2 ! number of ghost cells on all edges - ! Filter ! To be assigned in assign_dimensions (for filter) ! or get_grid_from_blocks (aether_to_dart, dart_to_aether). real(r8), allocatable :: levs(:), lats(:), lons(:) -! TODO: Sort out the precision of levs... in filter_*.nc versus Aether restarts. -! Can't just change this to r4. -! I'll need to read the dims from filter_input_0001.nc into r4 temp array, -! then convert to these r8 vars. integer :: nlev, nlat, nlon real(r8) :: lon_start, lon_delta, lat_start, lat_delta, lat_end -!----------------------------------------------------------------------- -! Day 0 in Aether's calendar is (+/1 a day) -4710/11/24 0 UTC -! integer :: aether_ref_day = 2451545.0_r8 ! cJULIAN2000 in Aether = day of date 2000/01/01. -character(len=32) :: calendar = 'GREGORIAN' - -! But what we care about is the ref time for the times in the files, which is 1965-1-1 00:00 -integer, dimension(:) :: aether_ref_date(5) = (/1965,1,1,0,0/) ! y,mo,d,h,m (secs assumed 0) -type(time_type) :: aether_ref_time -integer :: aether_ref_ndays, aether_ref_nsecs - !----------------------------------------------------------------------- ! to be assigned in the verify_variables subroutine -integer :: nvar, nvar_neutral, nvar_ion +integer :: nvar character(len=vtablenamelength) :: var_names(MAX_STATE_VARIABLES) real(r8) :: var_ranges(MAX_STATE_VARIABLES,2) @@ -220,8 +168,8 @@ module model_mod integer, parameter :: INVALID_ALTITUDE_VAL_ERROR_CODE = 17 integer, parameter :: UNKNOWN_OBS_QTY_ERROR_CODE = 20 -type(time_type) :: state_time ! module-storage declaration of current model time - +type(time_type) :: state_time ! module-storage declaration of current model time +character(len=32) :: calendar = 'GREGORIAN' character(len=512) :: error_string_1, error_string_2 contains @@ -248,9 +196,6 @@ subroutine static_init_model() call set_calendar_type(calendar) -! Debug global att creation time -! This filter_io_filename comes from the namelist (filter_input_0001.nc) -! Somehow filter is creating 'filter_output_0001.nc' when it dies. call assign_dimensions(filter_io_filename, levs, lats, lons, nlev, nlat, nlon) ! Dimension start and deltas needed for set_quad_coords @@ -270,7 +215,8 @@ subroutine static_init_model() ! Define which variables are in the model state ! This is using add_domain_from_file (arg list matches) -dom_id = add_domain(filter_io_filename, nvar, var_names(1:nvar), var_qtys(1:nvar), var_ranges(1:nvar,:), var_update(1:nvar)) +dom_id = add_domain(filter_io_filename, nvar, var_names(1:nvar), var_qtys(1:nvar), & + var_ranges(1:nvar,:), var_update(1:nvar)) call state_structure_info(dom_id) @@ -532,63 +478,6 @@ subroutine nc_write_model_atts(ncid, domain_id) end subroutine nc_write_model_atts -!----------------------------------------------------------------------- -! Add dimension variable contents to the file. - -subroutine def_fill_dimvars(ncid) - -integer, intent(in) :: ncid - -character(len=*), parameter :: routine = 'def_fill_dimvars' - -! call nc_begin_define_mode(ncid) - -! Global atts for aether_to_dart and dart_to_aether. -call nc_add_global_creation_time(ncid, routine) -call nc_add_global_attribute(ncid, "model_source", source, routine) -call nc_add_global_attribute(ncid, "model", "aether", routine) - -! define grid dimensions -call nc_define_dimension(ncid, trim(LEV_DIM_NAME), nlev, routine) -call nc_define_dimension(ncid, trim(LAT_DIM_NAME), nlat, routine) -call nc_define_dimension(ncid, trim(LON_DIM_NAME), nlon, routine) - -! define grid variables -! z -call nc_define_real_variable( ncid, trim(LEV_VAR_NAME), (/ trim(LEV_DIM_NAME) /), routine) -call nc_add_attribute_to_variable(ncid, trim(LEV_VAR_NAME), 'units', 'm', routine) -call nc_add_attribute_to_variable(ncid, trim(LEV_VAR_NAME), 'long_name', 'height above mean sea level', routine) - -! latitude -call nc_define_real_variable( ncid, trim(LAT_VAR_NAME), (/ trim(LAT_DIM_NAME) /), routine) -call nc_add_attribute_to_variable(ncid, trim(LAT_VAR_NAME), 'units', 'degrees_north', routine) -call nc_add_attribute_to_variable(ncid, trim(LAT_VAR_NAME), 'long_name', 'latitude', routine) - -! longitude -call nc_define_real_variable( ncid, trim(LON_VAR_NAME), (/ trim(LON_VAR_NAME) /), routine) -call nc_add_attribute_to_variable(ncid, trim(LON_VAR_NAME), 'units', 'degrees_east', routine) -call nc_add_attribute_to_variable(ncid, trim(LON_VAR_NAME), 'long_name', 'longitude', routine) - -! Dimension 'time' will no longer be created by write_model_time, -! or by nc_define_unlimited_dimension. It will be a scalar variable. -! time -call nc_define_real_scalar( ncid, trim(TIME_VAR_NAME), routine) -call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'calendar', 'gregorian', routine) -call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'units', 'days since 1601-01-01 00:00:00', routine) -call nc_add_attribute_to_variable(ncid, trim(TIME_VAR_NAME), 'long_name', 'gregorian_days', routine) - -call nc_end_define_mode(ncid) - -call nc_put_variable(ncid, trim(LEV_VAR_NAME), levs, routine) -call nc_put_variable(ncid, trim(LAT_VAR_NAME), lats, routine) -call nc_put_variable(ncid, trim(LON_VAR_NAME), lons, routine) -! time will be written elsewhere. - -! Flush the buffer and leave netCDF file open -call nc_synchronize_file(ncid) - -end subroutine def_fill_dimvars - !----------------------------------------------------------------------- ! Read dimension information from the template file and use ! it to assign values to variables. @@ -663,7 +552,7 @@ subroutine verify_variables(variables, file, nvar, & if ( varname == ' ' .or. dartstr == ' ' ) then error_string_1 = 'model_nml: variable list not fully specified' - error_string_2 = 'reading from "'//trim(filter_io_filename)//'"' + error_string_2 = 'reading from "'//trim(file)//'"' call error_handler(E_ERR, routine, error_string_1, & source, text2=error_string_2) endif @@ -681,8 +570,6 @@ subroutine verify_variables(variables, file, nvar, & ! All good to here - fill the output variables nvar = nvar + 1 - if (variables(VT_ORIGININDX,i) == 'neutrals') nvar_neutral = nvar_neutral + 1 - if (variables(VT_ORIGININDX,i) == 'ions') nvar_ion = nvar_ion + 1 var_names( nvar) = varname var_qtys( nvar) = quantity var_ranges(nvar,:) = (/ MISSING_R8, MISSING_R8 /) @@ -879,1346 +766,6 @@ subroutine ok_to_interpolate(qty, varid, istatus) end subroutine ok_to_interpolate -!----------------------------------------------------------------------- -! Converts Aether restart files to a netCDF file -! -! This routine needs: -! -! 1. A base dirname for the restart files (aether_restart_dirname). -! The filenames have the format 'dirname/{neutrals,ions}_mMMMM_gBBBB.rst' -! where BBBB is the block number, MMMM is the member number, -! and they have leading 0s. Blocks start in the -! southwest corner of the lat/lon grid and go east first, -! then to the west end of the next row north and end in the northeast corner. -! -! In the process, the routine will find: -! -! 1. The number of blocks in Lon and Lat (nblocks_lon, nblocks_lat) -! -! 2. The number of lons and lats in a single grid block (nx_per_block, ny_per_block, nz_per_block) -! -! 3. The overall grid size, {nlon,nlat,nalt} when you've read in all the blocks. -! -! 4. The number of neutral species (and probably a mapping between -! the species number and the variable name) (nvar_neutral) -! -! 5. The number of ion species (ditto - numbers <-> names) (nvar_ion) -! -! In addition to reading in the state data, it fills Longitude, Latitude, and Altitude arrays. -! This grid is orthogonal and rectangular but can have irregular spacing along -! any of the three dimensions. - -subroutine restart_files_to_netcdf(member) - -integer, intent(in) :: member - -integer :: ncid - -character(len=*), parameter :: routine = 'restart_files_to_netcdf' - -if (module_initialized ) then - write(error_string_1,'(3A)')'The aether static_init_model was already initialized but ', & - trim(routine), ' uses a separate initialization procedure' - call error_handler(E_ERR, routine, error_string_1, source ) -end if - -call static_init_blocks("aether_to_dart_nml") - -write(filter_io_filename,'(2A, I0.4, A3)') trim(filter_io_root),'_', member + 1,'.nc' -! nc_create_file does not leave define mode -ncid = nc_create_file(filter_io_filename) - -call error_handler(E_MSG, '', '') -write(error_string_1,'(3A)') 'converting Aether restart files in directory ', & - "'"//trim(aether_restart_dirname)//"'" -write(error_string_2,'(3A)') ' to the NetCDF file ', "'"//trim(filter_io_filename)//"'" -call error_handler(E_MSG, routine, error_string_1, text2=error_string_2) -call error_handler(E_MSG, '', '') - -! TODO: we haven't settled on the mechanism for identifying the state vector field names and source. -! (defined type, arrays, named indices,...) -! TODO: def_fill_dimvars functionality was in nc_write_model_atts but shouldn't have been. -! I separated nc_write_model_atts into to parts and this is one of them. -! Is this the best place for the call? It's in the "define" section for the filter_input file. -! It works. -call def_fill_dimvars(ncid) - -! Write_model_time will make a time variable, if needed, which it is not. -call write_model_time(ncid, state_time) - -! Define (non-time) variables -call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) - -! Read and convert (non-time) variables -call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) -! subr. called by this routine closes the file only if define = .true. -call nc_close_file(ncid) - -call error_handler(E_MSG, '', '') -write(error_string_1,'(3A)') 'Successfully converted the Aether restart files to ', & - "'"//trim(filter_io_filename)//"'" -call error_handler(E_MSG, routine, error_string_1) -call error_handler(E_MSG, '', '') - -end subroutine restart_files_to_netcdf - -!----------------------------------------------------------------------- -! Writes the state variables from a dart state vector (1d array) -! into Aether netcdf restart file sets. - -subroutine netcdf_to_restart_files(member) - -integer, intent(in) :: member - -integer :: ncid -character(len=*), parameter :: routine = 'netcdf_to_restart_files:' - -! write out the state vector data. -! when this routine returns all the data has been written. - -if (module_initialized ) then - write(error_string_1,'(3A)')'The aether mod was already initialized but ', & - trim(routine), ' uses a separate initialization procedure' - call error_handler(E_ERR, routine, error_string_1, source ) -end if - -call static_init_blocks("dart_to_aether_nml") - -write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member + 1,'.nc' - -call error_handler(E_MSG, routine, '', '') -write(error_string_1,'(3A)') 'Extracting fields from DART file ', "'"//trim(filter_io_filename)//"'" -write(error_string_2,'(3A)') 'into Aether restart files in directory ', & - "'"//trim(aether_restart_dirname)//"'" -call error_handler(E_MSG, routine, error_string_1, source, text2=error_string_2) - -ncid = nc_open_file_readonly(filter_io_filename, routine) - -call filter_to_restarts(ncid, member) - -!---------------------------------------------------------------------- -! Log what we think we're doing, and exit. -!---------------------------------------------------------------------- -call error_handler(E_MSG, routine,'','') -write(error_string_1,'(3A)') 'Successfully converted to the Aether restart files in directory' -write(error_string_2,'(3A)') "'"//trim(aether_restart_dirname)//"'" -call error_handler(E_MSG, routine, error_string_1, source, text2=error_string_2) - -call nc_close_file(ncid) - -end subroutine netcdf_to_restart_files - -!----------------------------------------------------------------------- -! ? Will this need to open the grid_{below,corners,down,left} filetypes? -! This code can handle it; a longer filetype passed in, and no member. -! ? Aether output files? - -function block_file_name(filetype, memnum, blocknum) - -character(len=*), intent(in) :: filetype ! one of {grid,ions,neutrals} -integer, intent(in) :: blocknum -integer, intent(in) :: memnum -character(len=128) :: block_file_name - -character(len=*), parameter :: routine = 'block_file_name' - -block_file_name = trim(filetype) -if (memnum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_m', memnum -if (blocknum >= 0) write(block_file_name, '(A,A2,I0.4)') trim(block_file_name), '_g', blocknum -block_file_name = trim(block_file_name)//'.nc' -if ( debug > 0 ) then - write(error_string_1,'("filename, memnum, blocknum = ",A,2(1x,i5))') & - trim(block_file_name), memnum, blocknum - call error_handler(E_MSG, routine, error_string_1, source) -endif - -end function block_file_name - -!----------------------------------------------------------------------- -! Like static_init_model, but for aether_to_dart and dart_to_aether. -! Read the namelist, -! parse the 'variables' table, -! get the Aether grid information -! convert the Aether time into a DART time. - -subroutine static_init_blocks(nml) - -character(len=*), intent(in) :: nml - -character(len=128) :: aether_filter_io_filename -integer :: iunit, io - -character(len=*), parameter :: routine = 'static_init_blocks' - -if (module_initialized) return ! only need to do this once - -! This prevents subroutines called from here from calling static_init_mod. -module_initialized = .true. - -!------------------ -! Read the namelist - -call find_namelist_in_file("input.nml", trim(nml), iunit) -if (trim(nml) == 'aether_to_dart_nml') then - read(iunit, nml = aether_to_dart_nml, iostat = io) - ! Record the namelist values used for the run - if (do_nml_file()) write(nmlfileunit, nml=aether_to_dart_nml) - if (do_nml_term()) write( * , nml=aether_to_dart_nml) -else if (trim(nml) == 'dart_to_aether_nml') then - read(iunit, nml = dart_to_aether_nml, iostat = io) - ! Record the namelist values used for the run - if (do_nml_file()) write(nmlfileunit, nml=dart_to_aether_nml) - if (do_nml_term()) write( * , nml=dart_to_aether_nml) -endif -call check_namelist_read(iunit, io, trim(nml)) ! closes, too. - - -! error-check, convert namelist input to arrays. -! 'variables' comes from the namelist in input.nml -call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) - -!-------------------------------- -! TODO: Set the time step -! Ensures model_advance_time is multiple of 'dynamics_timestep' - -! Aether uses Julian time internally, andor a Julian calendar -! (days from the start of the calendar), depending on the context) -call set_calendar_type( calendar ) - -!-------------------------------- -! 1) get grid dimensions -! 2) allocate space for the grids -! 3) read them from the block restart files, could be stretched ... - -call get_grid_info_from_blocks(aether_restart_dirname, nlon, nlat, nlev, nblocks_lon, & - nblocks_lat, nblocks_lev, lat_start, lat_end, lon_start) - -if( debug > 0 ) then - write(error_string_1,'(A,3I5)') 'grid dims are ', nlon, nlat, nlev - call error_handler(E_MSG, routine, error_string_1, source) -endif - -! Opens and closes the grid block file, but not the filter netcdf file. -call get_grid_from_blocks(aether_restart_dirname, nblocks_lon, nblocks_lat, nblocks_lev, & - nx_per_block, ny_per_block, nz_per_block) -! , lons, lats, levs ) - -! Convert the Aether reference date (not calendar day = 0 date) -! to the days and seconds of the calendar set in model_mod_nml. -aether_ref_time = set_date(aether_ref_date(1), aether_ref_date(2), aether_ref_date(3), & - aether_ref_date(4), aether_ref_date(5)) -call get_time(aether_ref_time, aether_ref_nsecs, aether_ref_ndays) - -! Get the model time from a restart file. -aether_filter_io_filename = block_file_name(variables(VT_ORIGININDX,1), 0, 0) -state_time = read_aether_time(trim(aether_restart_dirname)//'/'//trim(aether_filter_io_filename)) - -if ( debug > 0 ) then - write(error_string_1,'("grid: nlon, nlat, nlev =",3(1x,i5))') nlon, nlat, nlev - call error_handler(E_MSG, routine, error_string_1, source) -endif - -end subroutine static_init_blocks - -!----------------------------------------------------------------------- -! Read Aether's info file (UAM.in) to get a description of the restart file blocks' grids. - -subroutine get_grid_info_from_blocks(restart_dirname, nlon, nlat, nlev, & - nblocks_lon, nblocks_lat, nblocks_lev, & - lat_start, lat_end, lon_start) - -character(len=*), intent(in) :: restart_dirname -integer, intent(out) :: nlon ! Number of Longitude centers -integer, intent(out) :: nlat ! Number of Latitude centers -integer, intent(out) :: nlev ! Number of Vertical grid centers -integer, intent(out) :: nblocks_lon, nblocks_lat, nblocks_lev -real(r8), intent(out) :: lat_start, lat_end, lon_start - -character(len=100) :: c_line -character(len=256) :: file_loc -integer :: i, iunit, ios - -! TODO: get the grid info from a namelist (98 variables), instead of Aether's UAM.in. -! Then remove functions read_in_*. -! The rest of the UAM.in contents are for running Aether. -! Can wait until aether_to_dart push is done. -character(len=*), parameter :: filename = 'UAM.in' -character(len=*), parameter :: routine = 'get_grid_info_from_blocks' - -! get the ball rolling ... - -nblocks_lon = 0 -nblocks_lat = 0 -nblocks_lev = 0 -lat_start = 0.0_r8 -lat_end = 0.0_r8 -lon_start = 0.0_r8 - -write(file_loc,'(a,''/'',a)') trim(restart_dirname), trim(filename) - -if (debug > 4) then -write(error_string_1,'(3A)') 'Now opening Aether UAM file: ', trim(file_loc) -call error_handler(E_MSG, routine, error_string_1, source) -end if - - -iunit = open_file(trim(file_loc), action='read') - -UAMREAD : do i = 1, 1000000 - -read(iunit,'(a)',iostat=ios) c_line - -if (ios /= 0) then -! If we get to the end of the file or hit a read error without -! finding what we need, die. -write(error_string_1,'(3A)') 'cannot find #GRID in ', trim(file_loc) -call error_handler(E_ERR, routine, error_string_1, source) -endif - -if (c_line(1:5) .ne. "#GRID") cycle UAMREAD - -nblocks_lon = read_in_int( iunit,'nblocks_lon', trim(file_loc)) -nblocks_lat = read_in_int( iunit,'nblocks_lat', trim(file_loc)) -nblocks_lev = read_in_int( iunit,'nblocks_lev', trim(file_loc)) -lat_start = read_in_real(iunit,'lat_start', trim(file_loc)) -lat_end = read_in_real(iunit,'lat_end', trim(file_loc)) -lon_start = read_in_real(iunit,'lon_start', trim(file_loc)) - -exit UAMREAD - -enddo UAMREAD - -if (debug > 4) then -write(error_string_1,'(3A)') 'Successfully read Aether UAM grid file:', trim(file_loc) -call error_handler(E_MSG, routine, error_string_1, source) -write(error_string_1,'(A,I5)') ' nblocks_lon:', nblocks_lon -call error_handler(E_MSG, routine, error_string_1, source) -write(error_string_1,'(A,I5)') ' nblocks_lat:', nblocks_lat -call error_handler(E_MSG, routine, error_string_1, source) -write(error_string_1,'(A,I5)') ' nblocks_lev:', nblocks_lev -call error_handler(E_MSG, routine, error_string_1, source) -write(error_string_1,'(A,F15.4)') ' lat_start:', lat_start -call error_handler(E_MSG, routine, error_string_1, source) -write(error_string_1,'(A,F15.4)') ' lat_end:', lat_end -call error_handler(E_MSG, routine, error_string_1, source) -write(error_string_1,'(A,F15.4)') ' lon_start:', lon_start -call error_handler(E_MSG, routine, error_string_1, source) -end if - -call close_file(iunit) - -end subroutine get_grid_info_from_blocks - -!----------------------------------------------------------------------- -! Read block grid values (2D arrays) from a grid NetCDF file. -! Allocate and fill the full-domain 1-D dimension arrays (lon, lat, levs) - -subroutine get_grid_from_blocks(dirname, nblocks_lon, nblocks_lat, nblocks_lev, & - nx_per_block, ny_per_block, nz_per_block) -! , & -! lons, lats, levs ) - -character(len=*), intent(in) :: dirname -integer, intent(in) :: nblocks_lon ! Number of Longitude blocks -integer, intent(in) :: nblocks_lat ! Number of Latitude blocks -integer, intent(in) :: nblocks_lev ! Number of Altitude blocks -integer, intent(out) :: nx_per_block ! Number of non-halo Longitude centers per block -integer, intent(out) :: ny_per_block ! Number of non-halo Latitude centers per block -integer, intent(out) :: nz_per_block ! Number of Vertical grid centers -! real(r8), allocatable, intent(inout) :: lons(:), lats(:), levs(:) - -integer :: nb, offset, ncid, nboff -integer :: starts(3), ends(3), xcount, ycount, zcount -character(len=128) :: filename -real(r4), allocatable :: temp(:,:,:) - -character(len=*), parameter :: routine = 'get_grid_from_blocks' - -! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), -! in order to calculate the n[xyz]_per_block dimensions. -! grid_g0000.nc looks like a worthy candidate, but a restart could be used. -write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' -ncid = nc_open_file_readonly(filename, routine) - -! The grid (and restart) file variables have halos, so strip them off -! to get the number of actual data values in each dimension of the block. -nx_per_block = nc_get_dimension_size(ncid, 'x', routine) - (2 * nghost) -ny_per_block = nc_get_dimension_size(ncid, 'y', routine) - (2 * nghost) -nz_per_block = nc_get_dimension_size(ncid, 'z', routine) - -nlon = nblocks_lon * nx_per_block -nlat = nblocks_lat * ny_per_block -nlev = nblocks_lev * nz_per_block - -write(error_string_1,'(A,I5)') 'nlon = ', nlon -call error_handler(E_MSG, routine, error_string_1, source) -write(error_string_1,'(A,I5)') 'nlat = ', nlat -call error_handler(E_MSG, routine, error_string_1, source) -write(error_string_1,'(A,I5)') 'nlev = ', nlev -call error_handler(E_MSG, routine, error_string_1, source) - -! TODO; do these need to be deallocated somewhere? -! Probably not; this is only done once, and these arrays are needed -! through most of the a2d and d2a programs. -allocate( lons( nlon )) -allocate( lats( nlat )) -allocate( levs( nlev )) - -if (debug > 4) then - write(error_string_1,'(2A)') 'Successfully read Aether grid file:', trim(filename) - call error_handler(E_MSG, routine, error_string_1, source) - write(error_string_1,'(A,I5)') ' nx_per_block:', nx_per_block - call error_handler(E_MSG, routine, error_string_1, source) - write(error_string_1,'(A,I5)') ' ny_per_block:', ny_per_block - call error_handler(E_MSG, routine, error_string_1, source) - write(error_string_1,'(A,I5)') ' nz_per_block:', nz_per_block - call error_handler(E_MSG, routine, error_string_1, source) -endif - -! A temp array large enough to hold any of the 3D -! Lon, Lat or Alt arrays from a block plus ghost cells. -! The restart files have C-indexing (fastest changing dim is the last). -allocate(temp( 1:nz_per_block, & - 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost)) -temp = MISSING_R4 - -starts(1) = 1 - nghost -starts(2) = 1 - nghost -starts(3) = 1 -ends(1) = nx_per_block + nghost -ends(2) = ny_per_block + nghost -ends(3) = nz_per_block -xcount = nx_per_block + (2 * nghost) -ycount = ny_per_block + (2 * nghost) -zcount = nz_per_block -if ( debug > 0 ) then - write(error_string_1,'(2(A,3i5),A,3(1X,i5))') & - 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount - call error_handler(E_MSG, routine, error_string_1, source) -endif - -! go across the south-most block row picking up all longitudes -do nb = 1, nblocks_lon - - ! filename is trimmed by passage to open_block_file + "len=*" there. - filename = block_file_name('grid', -1, nb-1) - ncid = open_block_file(filename, 'read') - - ! Read 3D array and extract the longitudes of the non-halo data of this block. - ! The restart files have C-indexing (fastest changing dim is the last), - ! So invert the dimension bounds. - call nc_get_variable(ncid, 'Longitude', & - temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & - context=routine, & - nc_count=(/ zcount,ycount,xcount /)) - - offset = (nx_per_block * (nb - 1)) - lons(offset+1:offset+nx_per_block) = temp(1,1,1:nx_per_block) - - call nc_close_file(ncid) -enddo - -! go up west-most block row picking up all latitudes -do nb = 1, nblocks_lat - - ! Aether's block name counter start with 0, but the lat values can come from - ! any lon=const column of blocks. - nboff = ((nb - 1) * nblocks_lon) - filename = block_file_name('grid', -1, nboff) - ncid = open_block_file(filename, 'read') - - call nc_get_variable(ncid, 'Latitude', & - temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & - context=routine, nc_count=(/zcount,ycount,xcount/)) - - - offset = (ny_per_block * (nb - 1)) - lats(offset+1:offset+ny_per_block) = temp(1,1:ny_per_block,1) - - call nc_close_file(ncid) -enddo - - -! this code assumes UseTopography is false - that all columns share -! the same altitude array, so we can read it from the first block. -! if this is not the case, this code has to change. - -filename = block_file_name('grid', -1, 0) -ncid = open_block_file(filename, 'read') - -temp = MISSING_R8 -call nc_get_variable(ncid, 'Altitude', & - temp(starts(3):ends(3), starts(2):ends(2), starts(1):ends(1)), & - context=routine, nc_count=(/zcount,ycount,xcount/)) - -levs(1:nz_per_block) = temp(1:nz_per_block,1,1) - -call nc_close_file(ncid) - -deallocate(temp) - -! convert from radians into degrees -lons = lons * RAD2DEG -lats = lats * RAD2DEG - -if (debug > 4) then - print *, routine, 'All lons ', lons - print *, routine, 'All lats ', lats - print *, routine, 'All levs ', levs -endif - -if ( debug > 1 ) then ! Check dimension limits - write(error_string_1,'(A,2F15.4)') 'LON range ', minval(lons), maxval(lons) - call error_handler(E_MSG, routine, error_string_1, source) - write(error_string_1,'(A,2F15.4)') 'LAT range ', minval(lats), maxval(lats) - call error_handler(E_MSG, routine, error_string_1, source) - write(error_string_1,'(A,2F15.4)') 'ALT range ', minval(levs), maxval(levs) - call error_handler(E_MSG, routine, error_string_1, source) -endif - -end subroutine get_grid_from_blocks - -!----------------------------------------------------------------------- -! Read the Aether restart file time and convert to a DART time. - -function read_aether_time(filename) -type(time_type) :: read_aether_time -character(len=*), intent(in) :: filename - -integer :: ncid -integer :: tsimulation ! the time read from a restart file; seconds from aether_ref_date. -integer :: ndays, nsecs - -character(len=*), parameter :: routine = 'read_aether_time' - -tsimulation = MISSING_I - -ncid = open_block_file(filename, 'read') -call nc_get_variable(ncid, 'time', tsimulation, context=routine) -call nc_close_file(ncid, routine, filename) - -! Calculate the DART time of the file time. -! TODO: review calculation of ndays in read_aether_time -ndays = tsimulation / 86400 -nsecs = tsimulation - (ndays * 86400) -! The ref day is not finished, but don't need to subtract 1 because -! that was accounted for in the integer calculation of ndays. -ndays = aether_ref_ndays + ndays -read_aether_time = set_time(nsecs, ndays) - -if (do_output()) & - call print_time(read_aether_time, routine//': time in restart file '//filename) -if (do_output()) & - call print_date(read_aether_time, routine//': date in restart file '//filename) - -if (debug > 8) then - write(error_string_1,'(A,I5)')'tsimulation ', tsimulation - call error_handler(E_MSG, routine, error_string_1, source) - write(error_string_1,'(A,I5)')'ndays ', ndays - call error_handler(E_MSG, routine, error_string_1, source) - write(error_string_1,'(A,I5)')'nsecs ', nsecs - call error_handler(E_MSG, routine, error_string_1, source) - - call print_date(aether_ref_time, routine//':model base date') - call print_time(aether_ref_time, routine//':model base time') -endif - -end function read_aether_time - -!----------------------------------------------------------------------- -! Convert Aether's non-CF-compliant names into CF-compliant names for filter. -! For the ions, it moves the name of the ion from the end of the variable names -! to the beginning. - -function aether_name_to_dart(varname) - -character(len=vtablenamelength), intent(in) :: varname - -character(len=vtablenamelength) :: aether_name_to_dart, aether -character(len=64) :: parts(8), var_root -integer :: char_num, first, i_parts, aether_len, end_str - -aether = trim(varname) -aether_len = len_trim(varname) -parts = '' - -! Look for the last ' '. The characters after that are the species. -! If there's no ' ', the whole string is the species. -char_num = 0 -char_num = scan(trim(aether),' ', back=.true.) -var_root = aether(char_num+1:aether_len) -! purge_chars removes unwanted [()\] -parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) -! TODO: keep aether_name_to_dart diagnostic? Then add routine, error_handler. -! print*,'var_root, parts(1) = ', var_root, parts(1) -end_str = char_num - -! Tranform remaining pieces of varname into DART versions. -char_num = MISSING_I -first = 1 -i_parts = 2 -P_LOOP: do - ! This returns the position of the first blank *within the substring* passed in. - char_num = scan(aether(first:end_str),' ', back=.false.) - if (char_num > 0 .and. first < aether_len) then - parts(i_parts) = purge_chars(aether(first:first+char_num-1), '.)(\', plus_minus=.true.) - - first = first + char_num - i_parts = i_parts + 1 - else - exit P_LOOP - endif -enddo P_LOOP - -! Construct the DART field name from the parts -aether_name_to_dart = trim(parts(1)) -i_parts = 2 -Build : do - if (trim(parts(i_parts)) /= '') then - aether_name_to_dart = trim(aether_name_to_dart)//'_'//trim(parts(i_parts)) - i_parts = i_parts + 1 - else - exit Build - endif -enddo Build - -end function aether_name_to_dart - -!----------------------------------------------------------------------- -! Replace undesirable characters with better. - -function purge_chars(ugly_string, chars, plus_minus) - -character (len=*), intent(in) :: ugly_string, chars -logical, intent(in) :: plus_minus -character (len=64) :: purge_chars - -character (len=256) :: temp_str - -integer :: char_num, end_str, pm_num - -! Trim is not needed here -temp_str = ugly_string -end_str = len_trim(temp_str) -char_num = MISSING_I -Squeeze : do - ! Returns 0 if chars are not found - char_num = scan(temp_str, chars) - ! Need to change it to a char that won't be found by scan in the next iteration, - ! and can be easily removed. - if (char_num > 0) then - ! Squeeze out the character - temp_str(char_num:end_str-1) = temp_str(char_num+1:end_str) - temp_str(end_str:end_str) = '' -! temp_str(char_num:char_num) = ' ' - else - exit Squeeze - endif -enddo Squeeze - -! Replace + and - with pos and neg. Assume there's only 1. -temp_str = trim(adjustl(temp_str)) -end_str = len_trim(temp_str) -pm_num = scan(trim(temp_str),'+-', back=.false.) -if (pm_num == 0 .or. .not. plus_minus) then - purge_chars = trim(temp_str) -else - if (temp_str(pm_num:pm_num) == '+') then - purge_chars = temp_str(1:pm_num-1)//'pos' - else if (temp_str(pm_num:pm_num) == '-') then - purge_chars = temp_str(1:pm_num-1)//'neg' - endif - if (pm_num + 1 <= end_str) & - purge_chars = trim(purge_chars)//temp_str(pm_num+1:end_str) -endif - -end function purge_chars - -!----------------------------------------------------------------------- -! Open an Aether restart block file (neutral, ion, ...?) - -function open_block_file(filename, rw) - -! filename is trimmed by this definition -character(len=*), intent(in) :: filename -character(len=*), intent(in) :: rw ! 'read' or 'readwrite' -integer :: open_block_file - -character(len=*), parameter :: routine = 'open_block_file' - -if ( .not. file_exist(filename) ) then - write(error_string_1,'(4A)') 'cannot open file ', filename,' for ', rw - call error_handler(E_ERR, routine, error_string_1, source) -endif - -if (debug > 0) then - write(error_string_1,'(4A)') 'Opening file ', trim(filename), ' for ', rw - call error_handler(E_MSG, routine, error_string_1, source) -end if - - -if (rw == 'read') then - open_block_file = nc_open_file_readonly(filename, routine) -else if (rw == 'readwrite') then - open_block_file = nc_open_file_readwrite(filename, routine) -else - error_string_1 = ': must be called with rw={read,readwrite}, not '//rw - call error_handler(E_ERR, routine, error_string_1, source) -endif - - -if (debug > 80) then - write(error_string_1,'(4A)') 'Returned file descriptor is ', open_block_file - call error_handler(E_MSG, routine, error_string_1, source) -end if - -end function open_block_file - -!----------------------------------------------------------------------- -! Open all restart files (blocks x {neutrals,ions}) for 1 member -! and transfer the requested variable contents to the filter input file. -! This is called with 'define' = -! .true. define variables in the file or -! .false. transfer the data from restart files to a filter_inpu.nc file. - -subroutine restarts_to_filter(dirname, ncid_output, member, define) - -character(len=*), intent(in) :: dirname -integer, intent(in) :: ncid_output, member -logical, intent(in) :: define - -integer :: ib, jb, ib_loop, jb_loop - -if (define) then - ! if define, run one block. - ! the block_to_filter_io call defines the variables in the whole domain netCDF file. - ib_loop = 1 - jb_loop = 1 - ! nc_write_model_atts puts it in define, and takes it out. - call nc_begin_define_mode(ncid_output) -else - ! if not define, and run all blocks. - ! the block_to_filter_io call adds the (ib,jb) block to a netCDF variable - ! in order to make a file containing the data for all the blocks. - ib_loop = nblocks_lon - jb_loop = nblocks_lat -end if - -do jb = 1, jb_loop - do ib = 1, ib_loop - - call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) - - enddo -enddo - -if (define) then - call nc_end_define_mode(ncid_output) -endif - -end subroutine restarts_to_filter - -!----------------------------------------------------------------------- -! Read in a real number from the UAM.in file. -! TODO: the file name should not be filter_io_filename. - -function read_in_real(iunit, varname, filter_io_filename) - -integer, intent(in) :: iunit -character(len=*), intent(in) :: varname, filter_io_filename -real(r8) :: read_in_real - -character(len=100) :: c_line -integer :: i, ios -character(len=*), parameter :: routine = 'read_in_real' - -! Read a line -read(iunit,'(a)',iostat=ios) c_line -if (ios /= 0) then - write(error_string_1,'(4A)') 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR, routine, error_string_1, source) -endif - -! Remove anything after a space or TAB -i=index(c_line,' '); if( i > 0 ) c_line(i:len(c_line))=' ' -i=index(c_line,char(9)); if( i > 0 ) c_line(i:len(c_line))=' ' - -! Now that we have a line with nothing else ... parse it -read(c_line,*,iostat=ios) read_in_real - -if(ios /= 0) then - write(error_string_1,'(4A)')'unable to read '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR, routine, error_string_1, source) -endif - -end function read_in_real - -!----------------------------------------------------------------------- -! Read in an integer from the UAM.in file. -! TODO: the file name should not be filter_io_filename. - -function read_in_int(iunit, varname, filter_io_filename) - -integer, intent(in) :: iunit -character(len=*), intent(in) :: varname, filter_io_filename -integer :: read_in_int - -character(len=100) :: c_line -integer :: i, ios -character(len=*), parameter :: routine = 'read_in_int' - -! Read a line -read(iunit,'(a)',iostat=ios) c_line -if (ios /= 0) then - write(error_string_1,'(4A)') 'cannot find '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR,'get_grid_dims', error_string_1, source) -endif - -! Remove anything after a space or TAB -i=index(c_line,' '); if( i > 0 ) c_line(i:len(c_line))=' ' -i=index(c_line,char(9)); if( i > 0 ) c_line(i:len(c_line))=' ' - -read(c_line,*,iostat=ios) read_in_int - -if(ios /= 0) then - write(error_string_1,'(4A)')'unable to read '//trim(varname)//' in '//trim(filter_io_filename) - call error_handler(E_ERR, routine, error_string_1, source, & - text2=c_line) -endif - -end function read_in_int - -!----------------------------------------------------------------------- -! Open all restart files (neutrals,ions) for a block and read in the requested data items. -! The write_filter_io calls will write the data to the filter_input.nc. - -subroutine write_filter_io(data3d, varname, ib, jb, ncid) - -real(r4), intent(in) :: data3d(1:nz_per_block, & - 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost) - -character(len=vtablenamelength), intent(in) :: varname -integer, intent(in) :: ib, jb -integer, intent(in) :: ncid - -integer :: starts(3) - -character(len=*), parameter :: routine = 'write_filter_io' - -! write(varname,'(A)') trim(variables(VT_VARNAMEINDX,ivar)) - -! to compute the start, consider (ib-1)*nx_per_block+1 -starts(1) = 1 -starts(2) = (jb-1) * ny_per_block + 1 -starts(3) = (ib-1) * nx_per_block + 1 -! TODO: convert to error_msg -! print*, routine,'; starts = ', starts -! print*, routine,'; counts = ', nz_per_block, ny_per_block, nx_per_block,1 - -call nc_put_variable(ncid, varname, & - data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & - context=routine, nc_start=starts, & - nc_count=(/nz_per_block,ny_per_block,nx_per_block/)) -! TODO: convert to error_msg -! print*, routine,': filled varname = ', varname - -end subroutine write_filter_io - -!----------------------------------------------------------------------- -! Transfer variable data from a block restart file to the filter_input.nc file. -! It's called with 2 modes: -! define = .true. define the NC variables in the filter_input.nc -! define = .false. write the data from a block to the NC file using write_filter_io. - -subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) - -integer, intent(in) :: ncid_output -character(len=*), intent(in) :: dirname -integer, intent(in) :: ib, jb -integer, intent(in) :: member -logical, intent(in) :: define - -real(r4), allocatable :: temp1d(:), temp2d(:,:), temp3d(:,:,:) -real(r4), allocatable :: alt1d(:), density_ion_e(:,:,:) -integer :: ivar, nb, ncid_input -! TEC? integer :: maxsize -! logical :: no_idensity -! real(r4) :: temp0d -character(len=32) :: att_val -character(len=128) :: file_root -character(len=256) :: filename -character(len=vtablenamelength) :: varname, dart_varname - -character(len=*), parameter :: routine = 'block_to_filter_io' - -! The block number, as counted in Aether. -! Lower left is 0, increase to the East, then 1 row farther north, West to East. -nb = (jb - 1) * nblocks_lon + ib - 1 - -! a temp array large enough to hold any of the -! Lon,Lat or Alt array from a block plus ghost cells -allocate(temp1d(1-nghost:max(nx_per_block, ny_per_block, nz_per_block) + nghost)) - -! treat alt specially since we want to derive TEC here -! TODO: See density_ion_e too. -allocate( alt1d(1-nghost:max(nx_per_block, ny_per_block, nz_per_block) + nghost)) - -! temp array large enough to hold any 2D field -allocate(temp2d(1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost)) - -! TODO: We need all altitudes, but there might be vertical blocks in the future. -! But there would be no vertical halos. -! Make nzcount adapt to whether there are blocks. -! And temp needs to have C-ordering, which is what the restart files have. -! temp array large enough to hold 1 species, temperature, etc -allocate(temp3d(1:nz_per_block, & - 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost)) - -! TODO: Waiting for e- guidance from Aaron. -! save density_ion_e to compute TEC -allocate(density_ion_e(1:nz_per_block, & - 1-nghost:ny_per_block+nghost, & - 1-nghost:nx_per_block+nghost)) - -! TODO: Aether gives a unique name to each (of 6) velocity components. -! Do we want to use a temp4d array to handle them? -! They are independent variables in the block files (and state). -! ! temp array large enough to hold velocity vect, etc -! maxsize = max(3, nvar_ion) -! allocate(temp4d(1-nghost:nx_per_block+nghost, & -! 1-nghost:ny_per_block+nghost, & -! 1-nghost:nz_per_block+nghost, maxsize)) - - -! TODO; Does Aether need a replacement for these Density fields? Yes. -! But they are probably read by the loops below. -! Don't need to fetch index because Aether has NetCDF restarts, -! so just loop over the field names to read. -! -! ! assume we could not find the electron density for VTEC calculations -! no_idensity = .true. -! -! if (inum > 0) then -! ! one or more items in the state vector need to replace the -! ! data in the output file. loop over the index list in order. -! j = 1 -! ! TODO: electron density is not in the restart files, but it's needed for TEC -! In Aether they will be from an ions file, but now only from an output file (2023-10-30). -! Can that be handled like the neutrals and ions files, using variables(VT_ORIGININDX,:) -! to build an output file name? Are outputs in block form? -! ! save the electron density for TEC computation -! density_ion_e(:,:,:) = temp3d(:,:,:) - -! Handle the 2 restart file types (ions and neutrals). -! Each field has a file type associated with it: variables(VT_ORIGININDX,f_index) -! TODO: for now require that all neutrals are listed in variables before the ions. - -file_root = variables(VT_ORIGININDX,1) -filename = block_file_name(file_root, member, nb) -ncid_input = open_block_file(filename, 'read') - -! TODO: prints > ERR_MSG? -if (debug >= 100 .and. do_output()) print*,'block_to_filter_io: nvar_neutral = ', nvar_neutral -do ivar = 1, nvar_neutral - ! The nf90 functions cannot read the variable names with the '\'s in them. - varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - if (debug >= 100 .and. do_output()) print*, routine,'varname = ', varname - ! Translate the Aether field name into a DART field name. - dart_varname = aether_name_to_dart(varname) - - ! TODO: Given the subroutine name, perhaps these definition sections should be - ! one call higher up, with the same loop around it. - if (define) then - ! Define the variable in the filter_input.nc file (the output from this program). - ! The calling routine entered define mode. - - if (debug > 10 .and. do_output()) then - write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':', dart_varname - call error_handler(E_MSG, routine, error_string_1, source) - end if - - call nc_define_real_variable(ncid_output, dart_varname, & - (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) - call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) - call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units', att_val, routine) - - else if (file_root == 'neutrals') then - ! Read 3D array and extract the non-halo data of this block. -! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. - call nc_get_variable(ncid_input, varname, temp3d, context=routine) - if (debug >= 100 .and. do_output()) then - ! TODO convert to error_handler? Or diagnostics are no longer useful? - print*,'block_to_filter_io: temp3d = ', temp3d(1,1,1), temp3d(15,15,15), varname - print*,'block_to_filter_io: define = ', define - endif - call write_filter_io(temp3d, dart_varname, ib, jb, ncid_output) - else - write(error_string_1,'(A,I3,A)') 'Trying to read neutrals, but variables(', & - VT_ORIGININDX,ivar , ') /= "neutrals"' - call error_handler(E_ERR, routine, error_string_1, source) - endif - -enddo -call nc_close_file(ncid_input) - -file_root = variables(VT_ORIGININDX,nvar_neutral+1) -filename = block_file_name(file_root, member, nb) -ncid_input = open_block_file(filename, 'read') - -do ivar = nvar_neutral +1, nvar_neutral + nvar_ion - ! Purging \ from aether name. - varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - dart_varname = aether_name_to_dart(varname) - - if (define) then - - if (debug > 10 .and. do_output()) then - write(error_string_1,'(A,I0,2A)') 'Defining ivar = ', ivar,':', dart_varname - call error_handler(E_MSG, routine, error_string_1, source) - end if - - call nc_define_real_variable(ncid_output, dart_varname, & - (/ LEV_DIM_NAME, LAT_DIM_NAME, LON_DIM_NAME/) ) - call nc_get_attribute_from_variable(ncid_input, varname, 'units', att_val, routine) - call nc_add_attribute_to_variable(ncid_output, dart_varname, 'units', att_val, routine) - print*, routine,': defined ivar, dart_varname, att = ', ivar, dart_varname, att_val - - else if (file_root == 'ions') then - call nc_get_variable(ncid_input, varname, temp3d, context=routine) - call write_filter_io(temp3d, dart_varname, ib, jb, ncid_output) - else - write(error_string_1,'(A,I3,A)') 'Trying to read ions, but variables(', & - VT_ORIGININDX,ivar , ') /= "ions"' - call error_handler(E_ERR, routine, error_string_1, source) - endif - -enddo - -! Leave file open if fields were just added (define = .false.), -! so that time can be added. -if (define) call nc_close_file(ncid_input) - -! TODO: Does Aether need TEC to be calculated? Yes -! ! add the VTEC as an extended-state variable -! ! NOTE: This variable will *not* be written out to the Aether restart files -! -! if (no_idensity) then -! write(error_string_1,*) 'Cannot compute the VTEC without the electron density' -! call error_handler(E_ERR, routine, error_string_1, source) -! end if -! -! temp2d = 0._r8 -! ! compute the TEC integral -! do i =1,nz_per_block-1 ! approximate the integral over the altitude as a sum of trapezoids -! ! area of a trapezoid: A = (h2-h1) * (f2+f1)/2 -! temp2d(:,:) = temp2d(:,:) + ( alt1d(i+1)-alt1d(i) ) * & -! ( density_ion_e(:,:,i+1)+density_ion_e(:,:,i) ) /2.0_r8 -! end do -! ! convert temp2d to TEC units -! temp2d = temp2d/1e16_r8 -! call write_block_to_filter2d(temp2d, ivals(1), block, ncid, define) - -! TODO: Does Aether need f10_7 to be calculated or processed? Yes -! !gitm_index = get_index_start(domain_id, 'VerticalVelocity') -! call get_index_from_gitm_varname('f107', inum, ivals) -! if (inum > 0) then -! call write_block_to_filter0d(temp0d, ivals(1), ncid, define) !see comments in the body of the subroutine -! endif -! - -deallocate(temp1d, temp2d, temp3d) -deallocate(alt1d, density_ion_e) - -end subroutine block_to_filter_io - -!----------------------------------------------------------------------- -! Extract (updated) variables from a filter_output.nc file -! and write to existing block restart files. - -subroutine filter_to_restarts(ncid, member) - -integer, intent(in) :: member, ncid - -real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) -character(len=256) :: file_root -integer :: ivar -character(len=vtablenamelength) :: varname, dart_varname - -character(len=*), parameter :: routine = 'filter_to_restarts' - -! Space for full domain field (read from filter_output.nc) -! and halo around the full domain -allocate(fulldom3d(1:nlev, & - 1-nghost:nlat+nghost, & - 1-nghost:nlon+nghost)) - -! get the dirname, construct the filenames inside open_block_file - -! >>> TODO: Not all fields have halos suitable for calculating gradients. -! These do (2023-11-8): neutrals; temperature, O, O2, N2, and the horizontal winds. -! ions; none. -! The current model_mod will fill all neutral halos anyway, -! since that's simpler and won't break the model. -! TODO: add an attribute to the variables (?) to denote whether a field -! should have its halo filled. -do ivar = 1, nvar_neutral - varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - if (debug >= 0 .and. do_output()) then - write(error_string_1,'("varname = ",A)') trim(varname) - call error_handler(E_MSG, routine, error_string_1, source) - endif - dart_varname = aether_name_to_dart(varname) - - file_root = trim(variables(VT_ORIGININDX,ivar)) - if (file_root == 'neutrals') then - ! This parameter is available through the `use netcdf` command. - fulldom3d = NF90_FILL_REAL - - call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & - context=routine) - ! nc_count=(/ nlev,nlat,nlon,1 /), context=routine) - ! TODO: ncount not needed? Reading the whole field. - - ! Copy updated field values to full domain halo. - ! Block domains+halos will be easily read from this. - call add_halo_fulldom3d(fulldom3d) - - call filter_io_to_blocks(fulldom3d, varname, file_root, member) - else - ! TODO: error; varname is inconsistent with VT_ORIGININDX - endif - -enddo - -do ivar = nvar_neutral + 1, nvar_neutral + nvar_ion - varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) - dart_varname = aether_name_to_dart(varname) - - file_root = trim(variables(VT_ORIGININDX,ivar)) - if (debug >= 0 .and. do_output()) then - write(error_string_1,'("varname, dart_varname, file_root = ",3(2x,A))') & - trim(varname), trim(dart_varname), file_root - call error_handler(E_MSG, routine, error_string_1, source) - endif - - if (file_root == 'ions') then - fulldom3d = NF90_FILL_REAL - call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & - context=routine) - ! nc_count=(/ nlev,nlat,nlon,1 /), context=routine) - !? ncount not needed? Reading the whole field. - - ! 2023-11: ions do not have real or used data in their halos. - ! Make this clear by leaving the halos filled with MISSING_R4 - ! TODO: Will this be translated into NetCDF missing_value? - ! call add_halo_fulldom3d(fulldom3d) - - call filter_io_to_blocks(fulldom3d, varname, file_root, member) - - else - ! TODO: error; varname is inconsistent with VT_ORIGININDX - endif -enddo - -deallocate(fulldom3d) -!, fulldom1d - -end subroutine filter_to_restarts - -!----------------------------------------------------------------------- -! Copy updated data from the full domain into the halo regions, -! in preparation for extracting haloed blocks into the block restart files. -! First the halos past the East and West edges are taken from the wrap-around points. -! The halos beyond the edge latitudes in the North and South -! are taken by reaching over the pole to a longitude that's half way around the globe. -! This is independent of the number of blocks. - -subroutine add_halo_fulldom3d(fulldom3d) - -! Space for full domain field (read from filter_output.nc) -! and halo around the full domain -real(r4), intent(inout) :: fulldom3d(1:nz_per_block, & - 1-nghost:nlat+nghost, & - 1-nghost:nlon+nghost) - -integer :: g, i, j, haflat, haflon -real(r4), allocatable :: normed(:,:) -character(len=16) :: debug_format - -character(len=*), parameter :: routine = 'add_halo_fulldom3d' - -! An array for debugging by renormalizing an altitude of fulldom3d. -allocate(normed(1-nghost:nlat+nghost, & - 1-nghost:nlon+nghost)) - -haflat = nlat / 2 -haflon = nlon / 2 - -do g = 1,nghost - ! left; reach around the date line. - ! There's no data at the ends of the halos for this copy. - fulldom3d (:,1:nlat, 1-g) & - = fulldom3d(:,1:nlat,nlon+1-g) - - ! right - fulldom3d (:,1:nlat,nlon+g) & - = fulldom3d(:,1:nlat,g) - - ! bottom; reach over the S Pole for halo values. - ! There is data at the ends of the halos for these.) - - fulldom3d (:, 1-g ,1-nghost :haflon) & - = fulldom3d(:, g ,1-nghost+haflon:nlon) - fulldom3d (:, 1-g ,haflon+1:nlon) & - = fulldom3d(:, g , 1:haflon) - ! Last 2 (halo) points on the right edge (at the bottom) - fulldom3d (:, 1-g , nlon+1: nlon+nghost) & - = fulldom3d(:, g ,haflon+1:haflon+nghost) - - ! top - fulldom3d (:, nlat +g, 1-nghost :haflon) & - = fulldom3d(:, nlat+1-g, 1-nghost+haflon:nlon) - fulldom3d (:, nlat +g, haflon+1:nlon) & - = fulldom3d(:, nlat+1-g, 1:haflon) - ! Last 2 (halo) points on the right edge (at the top) - fulldom3d (:, nlat +g, nlon+1: nlon+nghost) & - = fulldom3d(:, nlat+1-g, haflon+1:haflon+nghost) -enddo - -if (any(fulldom3d == MISSING_R4)) then - error_string_1 = 'ERROR: some fulldom3d contain MISSING_R4 after halos' - call error_handler(E_ERR, routine, error_string_1, source) -endif - -! TODO: Keep halo corners check for future use? -! Add more robust rescaling. -! Debug; print the 4x4 arrays (corners & middle) -! to see whether values are copied correctly -! Level 44 values range from 800-eps to 805. I don't want to see the 80. -! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. -! 2023-12-20; Aaron sent new files with 54 levels. -if (debug >= 100 .and. do_output()) then - if (fulldom3d(54,10,10) > 1.e+10) then - normed = fulldom3d(54,:,:) - 1.1092e+10 - debug_format = '(3(4E10.4,2X))' - else if (fulldom3d(54,10,10) < 1000._r4) then - normed = fulldom3d(54,:,:) - 800._r4 - debug_format = '(3(4F10.5,2X))' - endif - - ! Debug HDF5 - write(error_string_1,'("normed_field(10,nlat+1,nlon+2) = ",3(1x,i5))') normed(nlat+1,nlon+2) - call error_handler(E_MSG, routine, error_string_1, source) - - ! 17 format debug_format - print*,'top' - do j = nlat+2, nlat-1, -1 - write(*,debug_format) (normed(j,i), i= -1, 2), & - (normed(j,i), i=haflon-1,haflon+2), & - (normed(j,i), i= nlon-1, nlon+2) - enddo - print*,'middle' - do j = haflat+2, haflat-1 , -1 - write(*,debug_format) (normed(j,i), i= -1, 2), & - (normed(j,i), i=haflon-1,haflon+2), & - (normed(j,i), i= nlon-1, nlon+2) - enddo - print*,'bottom' - do j = 2,-1, -1 - write(*,debug_format) (normed(j,i), i= -1, 2), & - (normed(j,i), i=haflon-1,haflon+2), & - (normed(j,i), i= nlon-1, nlon+2) - enddo -endif - -deallocate(normed) - -end subroutine add_halo_fulldom3d - -!----------------------------------------------------------------------- -! Transfer part of the full field into a block restart file. - -subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) - -real(r4), intent(in) :: fulldom3d(1:nz_per_block, & - 1-nghost:nlat+nghost, & - 1-nghost:nlon+nghost ) -character(len=*), intent(in) :: varname -character(len=*), intent(in) :: file_root -integer, intent(in) :: member - -! Don't collect velocity components (6 of them) -! real(r4) :: temp0d -! , temp1d(:) ? -integer :: ncid_output -integer :: ib, jb, nb -integer :: starts(3), ends(3), xcount, ycount, zcount -character(len=256) :: block_file - -character(len=*), parameter :: routine = 'filter_io_to_blocks' - -! a temp array large enough to hold any of the -! Lon,Lat or Alt array from a block plus ghost cells -! allocate(temp1d(1-nghost:max(nx_per_block,ny_per_block,nz_per_block)+nghost)) - - -zcount = nz_per_block -ycount = ny_per_block + (2 * nghost) -xcount = nx_per_block + (2 * nghost) - - -if (debug > 0 .and. do_output()) then - write(error_string_1,'(A,I0,A,I0,A)') 'Now putting the data for ', nblocks_lon, & - ' blocks lon by ',nblocks_lat,' blocks lat' - call error_handler(E_MSG, routine, error_string_1, source) -end if - -starts(1) = 1 -ends(1) = nz_per_block - -do jb = 1, nblocks_lat - starts(2) = (jb - 1) * ny_per_block - nghost + 1 - ends(2) = jb * ny_per_block + nghost - - do ib = 1, nblocks_lon - starts(3) = (ib - 1) * nx_per_block - nghost + 1 - ends(3) = ib * nx_per_block + nghost - - nb = (jb - 1) * nblocks_lon + ib - 1 - - block_file = block_file_name(trim(file_root), member, nb) - ncid_output = open_block_file(block_file, 'readwrite') - - ! TODO: error checking; does the block file have the field in it? - if ( debug > 0 .and. do_output()) then - write(error_string_1,'(A,3(2X,i5))') "block, ib, jb = ", nb, ib, jb - call error_handler(E_MSG, routine, error_string_1, source) - write(error_string_1,'(3(A,3i5))') & - 'starts = ',starts, 'ends = ',ends, '[xyz]counts = ',xcount,ycount,zcount - call error_handler(E_MSG, routine, error_string_1, source) - endif - - call nc_put_variable(ncid_output, trim(varname), & - fulldom3d(starts(1):ends(1), starts(2):ends(2), starts(3):ends(3)), & - context=routine, nc_count=(/ zcount,ycount,xcount /) ) - - call nc_close_file(ncid_output) - - enddo -enddo - -! -! TODO: ? Add f107 and Rho to the restart files -! call read_filter_io_block0d(ncid, ivals(1), data0d) -! if (data0d < 0.0_r8) data0d = 60.0_r8 !alex -! write(ounit) data0d - -end subroutine filter_io_to_blocks - !----------------------------------------------------------------------- ! End of model_mod !----------------------------------------------------------------------- diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index 08d8aba8c9..473d160e98 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -1,17 +1,8 @@ -TODO? Ben's: namelist - /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables - -Future?: -x estimate_f10_7 = .false. -x f10_7_file_name = 'f10_7.nc' -Not namelist (recompile for a big change like this): -x calendar = 'Gregorian' - &model_nml - filter_io_filename = 'other than filter_input_0001.nc' - debug = 100 - variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + filter_io_filename = 'if other than filter_input_0001.nc' + debug = 0 + variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'UPDATE', + 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' time_step_days = 0 time_step_seconds = 3600 / @@ -31,3 +22,7 @@ x calendar = 'Gregorian' ! Other neutrals Vertical\ Wind +Future?: +x estimate_f10_7 = .false. +x f10_7_file_name = 'f10_7.nc' + From 833d89bafa986bec3c94a93aeda4f221b708817b Mon Sep 17 00:00:00 2001 From: kdraeder Date: Fri, 2 Feb 2024 15:54:49 -0700 Subject: [PATCH 087/124] Added a Usage section and model_nml variables Fixed errors and wordsmithed. --- models/aether_lon-lat/readme.rst | 75 ++++++++++++++++++++------------ 1 file changed, 48 insertions(+), 27 deletions(-) diff --git a/models/aether_lon-lat/readme.rst b/models/aether_lon-lat/readme.rst index ac20acc2d3..5773cef391 100644 --- a/models/aether_lon-lat/readme.rst +++ b/models/aether_lon-lat/readme.rst @@ -16,6 +16,7 @@ The restart fields are divided among 2 types of files: neutrals and ions. They are further divided into "blocks", which are subdomains of the globe. Blocks start in the southwest corner of the lat/lon grid and go east first, then to the west end of the next row north and end in the northeast corner. +Each block has a halo around it filled with field values from neighboring blocks. All of these need to be combined to make a single state vector for filter. There's a unique set of these files for each member. The restart file names reflect this information: @@ -24,13 +25,13 @@ The restart file names reflect this information: | MMMM = ensemble member (0-based) | BBBB = block number (0-based) -These files do not have grid information in them, which must be read from +The restart files do not have grid information in them, which must be read from grid_gBBBB.nc Aether_to_dart and dart_to_aether read the same namelist; transform_state_nml. The fields chosen to be part of the model state are specified in ``variables``. -Program aether_to_dart will read the specified fields from all the restart -and grid files for a member and repackage them into an ensemble state vector +Program aether_to_dart will read the specified fields, from all the restarts +for a member plus grid files, and repackage them into an ensemble state vector file (filter_input.nc), which has a single domain and no halos. The field names will be transformed into CF-compliant names in filter_input.nc. @@ -104,28 +105,48 @@ transform_state_nml model_nml ......... -The fields listed in ``variables`` must be the *translated* names, -as found in the filter_input.nc files. -In general the transformation does the following - - - Remove all '\', '(', and ')' - - Replace blanks with underscores - - Replace '+' with 'pos' and '-' with 'neg' - - For ions, move the ion name from the end to the beginning. - -For example 'velocity_parallel_east\ \(O+_2D\)' becomes -'Opos_2D_velocity_parallel_east'. - -The ``variables`` in ``model_nml`` requires more information - - 1) Aether field name - #) DART "quantity" to be associated with the field - #) max value - #) min value - #) >>>>>>>> Fix this in code (filter doesn't need it) - #) which file contains the field ("neutrals" or "ions") - #) whether the field should be updated in the assimilation - - &model_nml - / +filter_io_filename + = 'if other than filter_input_0001.nc' + +variables + Each field to be included in the state vector requires 5 descriptors: + + 1) field name (transformed to CF-compliant) + #) DART "quantity" to be associated with the field + #) min value + #) max value + #) update the field in the restart file? {UPDATE,NO_COPY_BACK} + + The field names listed in ``variables`` must be the *transformed* names, + as found in the filter_input.nc files (see :ref:`Usage`). + In general the transformation does the following + + - Remove all '\\', '(', and ')' + - Replace blanks with underscores + - Replace '+' with 'pos' and '-' with 'neg' + - For ions, move the ion name from the end to the beginning. + + For example 'velocity_parallel_east\\ \\(O+_2D\\)' becomes 'Opos_2D_velocity_parallel_east'. + +time_step_days, time_step_seconds + = 0, 3600 The hindcast period between assimilations. + +.. _Usage: + +Usage +----- + +To test the transformation of files for member 0: +:: + +> cd {aether_restart_dirname} +> mkdir Orig +> cp *m0000* Orig +> ./aether_to_dart 0 +> cp filter_input_0001.nc filter_output_0001.nc +> ./dart_to_aether 0 + +| The filter\_ files now contain the CF-compliant field names which must be used in model_nml:variables. +| Compare the modified Aether restart files with those in Orig. +| (Some halo regions may have no data in them because Aether currently (2024-2) does not use those regions.) From 23a7aadfda93fcac16a36c4cb5b285e3744d30f5 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Fri, 2 Feb 2024 23:01:17 -0700 Subject: [PATCH 088/124] Update model_mod to assign variables to instance of var_type --- models/aether_lon-lat/model_mod.f90 | 150 ++++++++++++---------------- 1 file changed, 62 insertions(+), 88 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 8dbc584ba0..aeb0d72b1c 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -112,7 +112,17 @@ module model_mod ! to diagnostics). integer, parameter :: MAX_STATE_VARIABLES = 100 integer, parameter :: NUM_STATE_TABLE_COLUMNS = 5 -character(len=vtablenamelength) :: variables(NUM_STATE_TABLE_COLUMNS,MAX_STATE_VARIABLES) = ' ' +character(len=vtablenamelength) :: variables(NUM_STATE_TABLE_COLUMNS,MAX_STATE_VARIABLES) = '' + +type :: var_type + integer :: count + character(len=64), allocatable :: names(:) + integer, allocatable :: qtys(:) + real(r8), allocatable :: clamp_values(:, :) + logical, allocatable :: updates(:) +end type var_type + +type(var_type) :: var namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables @@ -153,12 +163,6 @@ module model_mod !----------------------------------------------------------------------- ! to be assigned in the verify_variables subroutine -integer :: nvar - -character(len=vtablenamelength) :: var_names(MAX_STATE_VARIABLES) -real(r8) :: var_ranges(MAX_STATE_VARIABLES,2) -logical :: var_update(MAX_STATE_VARIABLES) -integer :: var_qtys(MAX_STATE_VARIABLES) type(quad_interp_handle) :: quad_interp @@ -204,7 +208,7 @@ subroutine static_init_model() lat_start = lats(1) lat_delta = lats(2) - lats(1) -call verify_variables(variables, filter_io_filename, nvar, var_names, var_qtys, var_ranges, var_update) +var = assign_var(variables, MAX_STATE_VARIABLES) ! This time is both the minimum time you can ask the model to advance ! (for models that can be advanced by filter) and it sets the assimilation @@ -215,8 +219,8 @@ subroutine static_init_model() ! Define which variables are in the model state ! This is using add_domain_from_file (arg list matches) -dom_id = add_domain(filter_io_filename, nvar, var_names(1:nvar), var_qtys(1:nvar), & - var_ranges(1:nvar,:), var_update(1:nvar)) +dom_id = add_domain(filter_io_filename, var%count, var%names, var%qtys, & + var%clamp_values, var%updates) call state_structure_info(dom_id) @@ -516,84 +520,54 @@ end subroutine assign_dimensions !----------------------------------------------------------------------- ! Parse the table of variables' characteristics into arrays for easier access. -subroutine verify_variables(variables, file, nvar, & - var_names, var_qtys, var_ranges, var_update) - -character(len=*), intent(in) :: variables(:,:) -character(len=*), intent(inout) :: file -integer, intent(out) :: nvar -character(len=*), intent(out) :: var_names(:) -real(r8), intent(out) :: var_ranges(:,:) -logical, intent(out) :: var_update(:) -integer, intent(out) :: var_qtys(:) - -character(len=*), parameter :: routine = 'verify_variables' - -integer :: io, i, quantity -real(r8) :: minvalue, maxvalue - -character(len=vtablenamelength) :: varname -character(len=vtablenamelength) :: dartstr -character(len=vtablenamelength) :: minvalstring -character(len=vtablenamelength) :: maxvalstring -character(len=vtablenamelength) :: state_or_aux - -nvar = 0 -MY_LOOP : do i = 1, size(variables,2) - -! TODO Why define these intermediate strings? Is the code clearer or faster? - varname = variables(VT_VARNAMEINDX,i) - dartstr = variables(VT_KINDINDX,i) - minvalstring = variables(VT_MINVALINDX,i) - maxvalstring = variables(VT_MAXVALINDX,i) - state_or_aux = variables(VT_STATEINDX,i) - - if ( varname == ' ' .and. dartstr == ' ' ) exit MY_LOOP ! Found end of list. - - if ( varname == ' ' .or. dartstr == ' ' ) then - error_string_1 = 'model_nml: variable list not fully specified' - error_string_2 = 'reading from "'//trim(file)//'"' - call error_handler(E_ERR, routine, error_string_1, & - source, text2=error_string_2) - endif - - ! The internal DART routines check if the variable name is valid. - - ! Make sure DART kind is valid - quantity = get_index_for_quantity(dartstr) - if( quantity < 0 ) then - write(error_string_1,'(''there is no obs_kind "'',a,''" in obs_kind_mod.f90'')') & - trim(dartstr) - call error_handler(E_ERR, routine, error_string_1, source) - endif - - ! All good to here - fill the output variables - - nvar = nvar + 1 - var_names( nvar) = varname - var_qtys( nvar) = quantity - var_ranges(nvar,:) = (/ MISSING_R8, MISSING_R8 /) - var_update(nvar) = .false. ! at least initially - - ! convert the [min,max]valstrings to numeric values if possible - read(minvalstring,*,iostat=io) minvalue - if (io == 0) var_ranges(nvar,1) = minvalue - - read(maxvalstring,*,iostat=io) maxvalue - if (io == 0) var_ranges(nvar,2) = maxvalue - - call to_upper(state_or_aux) - if (state_or_aux == 'UPDATE') var_update(nvar) = .true. - -enddo MY_LOOP - -if (nvar == MAX_STATE_VARIABLES) then - error_string_1 = 'WARNING: you may need to increase "MAX_STATE_VARIABLES"' - write(error_string_2,'(''you have specified at least '',i4,'' perhaps more.'')') nvar - call error_handler(E_MSG, routine, error_string_1, source, text2=error_string_2) -endif - -end subroutine verify_variables +function assign_var(variables, MAX_STATE_VARIABLES) result(var) + + character(len=vtablenamelength), intent(in) :: variables(:, :) + integer, intent(in) :: MAX_STATE_VARIABLES + + type(var_type) :: var + + integer :: ivar + + ! Loop through the variables array to get the actual count of the number of variables + do ivar = 1, MAX_STATE_VARIABLES + ! If the element is an empty string, the loop has exceeded the extent of the variables + if (variables(1, ivar) == '') then + var%count = ivar-1 + exit + endif + enddo + + ! Allocate the arrays in the var derived type + allocate(var%names(var%count), var%qtys(var%count), var%clamp_values(var%count, 2), var%updates(var%count)) + + do ivar = 1, var%count + + var%names(ivar) = trim(variables(1, ivar)) + + var%qtys(ivar) = get_index_for_quantity(variables(2, ivar)) + + if (variables(3, ivar) /= 'NA') then + read(variables(3, ivar), '(d16.8)') var%clamp_values(ivar,1) + else + var%clamp_values(ivar,1) = MISSING_R8 + endif + + if (variables(4, ivar) /= 'NA') then + read(variables(4, ivar), '(d16.8)') var%clamp_values(ivar,2) + else + var%clamp_values(ivar,2) = MISSING_R8 + endif + + if (variables(5, ivar) == 'UPDATE') then + var%updates(ivar) = .true. + else + var%updates(ivar) = .false. + endif + + enddo + +end function assign_var !----------------------------------------------------------------------- ! Extract state values needed by the interpolation from all ensemble members. From 713b02762599216826a0fcf59dd7cc1df96d0602 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Fri, 2 Feb 2024 23:07:11 -0700 Subject: [PATCH 089/124] Update input.nml to remove origin column from variables entry --- models/aether_lon-lat/work/input.nml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index 5be83c911f..5e2acdfff1 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -132,8 +132,8 @@ &model_nml filter_io_filename = 'filter_input_0001.nc' - variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'neutrals', 'UPDATE', - 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' + variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', + 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' time_step_days = 0 time_step_seconds = 3600 debug = 10 From e390c1d13831ca9fc807cca67e60f38c2fb878d9 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Mon, 5 Feb 2024 12:51:48 -0700 Subject: [PATCH 090/124] Update aether work directory with sample obs_seq.out file and consistent input.nml entries --- models/aether_lon-lat/work/filter_inputs.txt | 20 ++++++++++++ models/aether_lon-lat/work/filter_outputs.txt | 20 ++++++++++++ models/aether_lon-lat/work/input.nml | 8 ++--- models/aether_lon-lat/work/obs_seq.out.1 | 31 +++++++++++++++++++ 4 files changed, 75 insertions(+), 4 deletions(-) create mode 100644 models/aether_lon-lat/work/filter_inputs.txt create mode 100644 models/aether_lon-lat/work/filter_outputs.txt create mode 100644 models/aether_lon-lat/work/obs_seq.out.1 diff --git a/models/aether_lon-lat/work/filter_inputs.txt b/models/aether_lon-lat/work/filter_inputs.txt new file mode 100644 index 0000000000..c5891b8e29 --- /dev/null +++ b/models/aether_lon-lat/work/filter_inputs.txt @@ -0,0 +1,20 @@ +filter_input_0001.nc +filter_input_0002.nc +filter_input_0003.nc +filter_input_0004.nc +filter_input_0005.nc +filter_input_0006.nc +filter_input_0007.nc +filter_input_0008.nc +filter_input_0009.nc +filter_input_0010.nc +filter_input_0011.nc +filter_input_0012.nc +filter_input_0013.nc +filter_input_0014.nc +filter_input_0015.nc +filter_input_0016.nc +filter_input_0017.nc +filter_input_0018.nc +filter_input_0019.nc +filter_input_0020.nc diff --git a/models/aether_lon-lat/work/filter_outputs.txt b/models/aether_lon-lat/work/filter_outputs.txt new file mode 100644 index 0000000000..1b23ee7982 --- /dev/null +++ b/models/aether_lon-lat/work/filter_outputs.txt @@ -0,0 +1,20 @@ +filter_output_0001.nc +filter_output_0002.nc +filter_output_0003.nc +filter_output_0004.nc +filter_output_0005.nc +filter_output_0006.nc +filter_output_0007.nc +filter_output_0008.nc +filter_output_0009.nc +filter_output_0010.nc +filter_output_0011.nc +filter_output_0012.nc +filter_output_0013.nc +filter_output_0014.nc +filter_output_0015.nc +filter_output_0016.nc +filter_output_0017.nc +filter_output_0018.nc +filter_output_0019.nc +filter_output_0020.nc diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index 5e2acdfff1..59ccf5d278 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -49,7 +49,7 @@ perturb_from_single_instance = .false., perturbation_amplitude = 0.2, - stages_to_write = 'output' + stages_to_write = 'preassim', 'analysis' single_file_out = .false., output_state_files = '' @@ -132,8 +132,8 @@ &model_nml filter_io_filename = 'filter_input_0001.nc' - variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', - 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' + variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', + 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' time_step_days = 0 time_step_seconds = 3600 debug = 10 @@ -224,7 +224,7 @@ / &obs_kind_nml - assimilate_these_obs_types = 'GPS_VTEC_EXTRAP', 'GPS_PROFILE', 'COSMIC_ELECTRON_DENSITY' + assimilate_these_obs_types = 'AIRS_TEMPERATURE' evaluate_these_obs_types = '' / diff --git a/models/aether_lon-lat/work/obs_seq.out.1 b/models/aether_lon-lat/work/obs_seq.out.1 new file mode 100644 index 0000000000..1cd14ccb15 --- /dev/null +++ b/models/aether_lon-lat/work/obs_seq.out.1 @@ -0,0 +1,31 @@ + obs_sequence +obs_kind_definitions + 1 + 33 AIRS_TEMPERATURE + num_copies: 1 num_qc: 1 + num_obs: 2 max_num_obs: 2 +observation +Data QC + first: 1 last: 2 + OBS 1 + 271.330627441406 + 0.000000000000000E+000 + -1 2 -1 +obdef +loc3d + 3.406717740263719 0.5806184282903090 100000.0000000000 3 +kind + 33 +84601 153130 + 1.07229244766182 + OBS 2 + 27450.2966235645 + 0.000000000000000E+000 + 1 -1 -1 +obdef +loc3d + 3.484538383406885 0.5925166389933947 120000.0000000000 3 +kind + 33 +84601 153130 + 1.03153675838621 \ No newline at end of file From a280c91bba57d728923b3e5dc7181fd253131e5e Mon Sep 17 00:00:00 2001 From: kdraeder Date: Mon, 5 Feb 2024 14:15:23 -0700 Subject: [PATCH 091/124] Removed global variables from arg list. Resolved TODOs Added error checks and diagnostics. Model_mod_check passes 1-5,7. --- models/aether_lon-lat/aether_to_dart.f90 | 16 ++------- models/aether_lon-lat/dart_to_aether.f90 | 34 +++++++++++-------- models/aether_lon-lat/model_mod.f90 | 23 ++----------- models/aether_lon-lat/transform_state_mod.f90 | 31 ++++++----------- 4 files changed, 35 insertions(+), 69 deletions(-) diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index 71d785d1e7..bcd0fe203f 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -211,8 +211,8 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! TODO: We need all altitudes, but there might be vertical blocks in the future. ! But there would be no vertical halos. -! Make nzcount adapt to whether there are blocks. -! And temp needs to have C-ordering, which is what the restart files have. +! Make transform_state_mod: zcount adapt to whether there are blocks. +! Temp needs to have C-ordering, which is what the restart files have. ! temp array large enough to hold 1 species, temperature, etc allocate(temp3d(1:nz_per_block, & 1-nghost:ny_per_block+nghost, & @@ -255,7 +255,6 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! Handle the 2 restart file types (ions and neutrals). ! Each field has a file type associated with it: variables(VT_ORIGININDX,f_index) -! TODO: for now require that all neutrals are listed in variables before the ions. file_root = variables(VT_ORIGININDX,1) filename = block_file_name(file_root, member, nb) @@ -286,13 +285,7 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) else if (file_root == 'neutrals') then ! Read 3D array and extract the non-halo data of this block. -! TODO: There are no 2D or 1D fields in ions or neutrals, but there could be; different temp array. call nc_get_variable(ncid_input, varname, temp3d, context=routine) - if (debug >= 100 .and. do_output()) then - ! TODO convert to error_handler? Or diagnostics are no longer useful? - print*,'block_to_filter_io: temp3d = ', temp3d(1,1,1), temp3d(15,15,15), varname - print*,'block_to_filter_io: define = ', define - endif call write_filter_io(temp3d, dart_varname, ib, jb, ncid_output) else write(error_string_1,'(A,I3,A)') 'Trying to read neutrals, but variables(', & @@ -398,16 +391,11 @@ subroutine write_filter_io(data3d, varname, ib, jb, ncid) starts(1) = 1 starts(2) = (jb-1) * ny_per_block + 1 starts(3) = (ib-1) * nx_per_block + 1 -! TODO: convert to error_msg -! print*, routine,'; starts = ', starts -! print*, routine,'; counts = ', nz_per_block, ny_per_block, nx_per_block,1 call nc_put_variable(ncid, varname, & data3d(1:nz_per_block,1:ny_per_block,1:nx_per_block), & context=routine, nc_start=starts, & nc_count=(/nz_per_block,ny_per_block,nx_per_block/)) -! TODO: convert to error_msg -! print*, routine,': filled varname = ', varname end subroutine write_filter_io diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90 index 0cabd31749..ce210be5c0 100644 --- a/models/aether_lon-lat/dart_to_aether.f90 +++ b/models/aether_lon-lat/dart_to_aether.f90 @@ -33,7 +33,7 @@ program dart_to_aether nc_add_global_attribute, nc_add_global_creation_time, & nc_get_attribute_from_variable, nc_add_attribute_to_variable, & nc_define_real_variable, nc_define_real_scalar, & - nc_get_variable, nc_put_variable, & + nc_get_variable, nc_put_variable, nc_variable_exists, & nc_synchronize_file, NF90_FILL_REAL implicit none @@ -123,13 +123,13 @@ subroutine filter_to_restarts(ncid, member) ! get the dirname, construct the filenames inside open_block_file -! >>> TODO: Not all fields have halos suitable for calculating gradients. -! These do (2023-11-8): neutrals; temperature, O, O2, N2, and the horizontal winds. -! ions; none. -! The current model_mod will fill all neutral halos anyway, -! since that's simpler and won't break the model. -! TODO: add an attribute to the variables (?) to denote whether a field -! should have its halo filled. +! Not all fields have halos suitable for calculating gradients. +! These do (2023-11-8): neutrals; temperature, O, O2, N2, and the horizontal winds. +! ions; none. +! The current transform_state will fill all neutral halos anyway, +! since that's simpler and won't break the model. +! TODO: add an attribute to the variables (?) to denote whether a field +! should have its halo filled? do ivar = 1, nvar_neutral varname = purge_chars(trim(variables(VT_VARNAMEINDX,ivar)), '\', plus_minus=.false.) if (debug >= 0 .and. do_output()) then @@ -151,7 +151,9 @@ subroutine filter_to_restarts(ncid, member) call filter_io_to_blocks(fulldom3d, varname, file_root, member) else - ! TODO: error; varname is inconsistent with VT_ORIGININDX + write(error_string_1,'(3A)') "file_root of varname = ",trim(varname), & + ' expected to be "neutrals"' + call error_handler(E_ERR, routine, error_string_1, source) endif enddo @@ -179,7 +181,9 @@ subroutine filter_to_restarts(ncid, member) call filter_io_to_blocks(fulldom3d, varname, file_root, member) else - ! TODO: error; varname is inconsistent with VT_ORIGININDX + write(error_string_1,'(3A)') "file_root of varname = ",trim(varname), & + ' expected to be "ions"' + call error_handler(E_ERR, routine, error_string_1, source) endif enddo @@ -256,8 +260,7 @@ subroutine add_halo_fulldom3d(fulldom3d) ! TODO: Keep halo corners check for future use? ! Add more robust rescaling. -! Debug; print the 4x4 arrays (corners & middle) -! to see whether values are copied correctly +! Print the 4x4 arrays (corners & middle) to see whether values are copied correctly. ! Level 44 values range from 800-eps to 805. I don't want to see the 80. ! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. ! 2023-12-20; Aaron sent new files with 54 levels. @@ -350,8 +353,11 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) block_file = block_file_name(trim(file_root), member, nb) ncid_output = open_block_file(block_file, 'readwrite') - - ! TODO: error checking; does the block file have the field in it? + if (.not.nc_variable_exists(ncid_output,varname)) then + write(error_string_1,'(4A)') 'variable ', varname, ' does not exist in ',block_file + call error_handler(E_ERR, routine, error_string_1, source) + endif + if ( debug > 0 .and. do_output()) then write(error_string_1,'(A,3(2X,i5))') "block, ib, jb = ", nb, ib, jb call error_handler(E_MSG, routine, error_string_1, source) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index aeb0d72b1c..a9404b7099 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -97,19 +97,11 @@ module model_mod !----------------------------------------------------------------------- ! Default values for namelist -! TODO: replace model_nml:filter_io_filename with filter_io_root, -! so that namelist doesn't need to be changed for each member character(len=256) :: filter_io_filename = 'filter_input_0001.nc' integer :: time_step_days = 0 integer :: time_step_seconds = 3600 integer :: debug = 0 -! TODO: Should this be defined here, or does it come from netcdf_utilities_mod.f90? -! It's a public parameter from that module, which gets it from the netcdf module -! https://docs.unidata.ucar.edu/netcdf-fortran/current/f90-variables.html#f90-variables-introduction -! integer, parameter :: NF90_MAX_NAME = 256 -! This module uses vtablenamelength instead (which is shorter = less white space output -! to diagnostics). integer, parameter :: MAX_STATE_VARIABLES = 100 integer, parameter :: NUM_STATE_TABLE_COLUMNS = 5 character(len=vtablenamelength) :: variables(NUM_STATE_TABLE_COLUMNS,MAX_STATE_VARIABLES) = '' @@ -137,12 +129,6 @@ module model_mod !----------------------------------------------------------------------- ! Dimensions -! TODO: using length * causes(?) a problem when calling nc_define_var_real_Nd -! with the list of dim_names in this order. nc_define also uses size * -! and apparently looks at the first one, sees that it's size 3, and assumes that for all. -! routine: nc_define_var_real_Nd -! message: "Temperature" inquire dimension id for dim "tim": -! errcode -46= NetCDF: Invalid dimension ID or name character(len=4), parameter :: LEV_DIM_NAME = 'alt' character(len=4), parameter :: LAT_DIM_NAME = 'lat' character(len=4), parameter :: LON_DIM_NAME = 'lon' @@ -200,7 +186,7 @@ subroutine static_init_model() call set_calendar_type(calendar) -call assign_dimensions(filter_io_filename, levs, lats, lons, nlev, nlat, nlon) +call assign_dimensions(filter_io_filename) ! Dimension start and deltas needed for set_quad_coords lon_start = lons(1) @@ -472,8 +458,6 @@ subroutine nc_write_model_atts(ncid, domain_id) call nc_add_global_attribute(ncid, "model_source", source, routine) call nc_add_global_attribute(ncid, "model", "aether", routine) -! TODO Shouldn't the calendar type be defined here? -! It's defined in the time variable = good enough for write_model_time. call nc_end_define_mode(ncid) @@ -486,12 +470,9 @@ end subroutine nc_write_model_atts ! Read dimension information from the template file and use ! it to assign values to variables. -subroutine assign_dimensions(filter_io_filename, levs, lats, lons, nlev, nlat, nlon) +subroutine assign_dimensions(filter_io_filename) character(len=*), intent(in) :: filter_io_filename -! TODO: conflict between lons,... being global storage and passed to assign_dimensions? -real(r8), allocatable, intent(out) :: levs(:), lats(:), lons(:) -integer, intent(out) :: nlev, nlat, nlon integer :: ncid character(len=24), parameter :: routine = 'assign_dimensions' diff --git a/models/aether_lon-lat/transform_state_mod.f90 b/models/aether_lon-lat/transform_state_mod.f90 index 78a0b1ec3b..c1b9b49cb3 100644 --- a/models/aether_lon-lat/transform_state_mod.f90 +++ b/models/aether_lon-lat/transform_state_mod.f90 @@ -137,18 +137,9 @@ subroutine static_init_blocks() call check_namelist_read(iunit, io, 'transform_state_nml') ! closes, too. -! error-check, convert namelist input to arrays. -! 'variables' comes from the namelist in input.nml -! TODO: we haven't settled on the mechanism for identifying the state vector field names and source. -! (defined type, arrays, named indices,...) -! After splitting a2d and d2a routines out of model_mod, they can't use -! the model_mod:verify_variables. This calls a new one. +! error-check, convert namelist input 'variables' to global variables. call verify_variables(variables) -!-------------------------------- -! TODO: Set the time step -! Ensures model_advance_time is multiple of 'dynamics_timestep' - ! Aether uses Julian time internally, andor a Julian calendar ! (days from the start of the calendar), depending on the context) call set_calendar_type( calendar ) @@ -203,7 +194,13 @@ subroutine verify_variables(variables) if ( varname == ' ' .and. rootstr == ' ' ) exit MY_LOOP ! Found end of list. if ( varname == ' ' .or. rootstr == ' ' ) then - error_string_1 = 'model_nml: variable list not fully specified' + error_string_1 = 'variable list not fully specified' + call error_handler(E_ERR, routine, error_string_1, source) + endif + + if (i > 1 .and. variables(VT_ORIGININDX,i-1) == 'ions' .and. rootstr /= 'ions' ) then + write(error_string_1,'(A,I1,A)') ' File type (',i, & + ') in transform_state_nml:variables is out of order or invalid.' call error_handler(E_ERR, routine, error_string_1, source) endif @@ -293,9 +290,9 @@ subroutine get_grid_from_blocks(dirname) character(len=*), parameter :: routine = 'get_grid_from_blocks' -! TODO: Here it needs to read the x,y,z from a NetCDF block file(s), -! in order to calculate the n[xyz]_per_block dimensions. -! grid_g0000.nc looks like a worthy candidate, but a restart could be used. +! Read the x,y,z from a NetCDF block file(s), +! in order to calculate the n[xyz]_per_block dimensions. +! grid_g0000.nc looks like a worthy candidate, but a restart could be used. write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' ncid = nc_open_file_readonly(filename, routine) @@ -312,9 +309,6 @@ subroutine get_grid_from_blocks(dirname) write(error_string_1,'(3(A,I5))') 'nlon = ', nlon, 'nlat = ', nlat, 'nlev = ', nlev call error_handler(E_MSG, routine, error_string_1, source) -! TODO; do these need to be deallocated somewhere? -! Probably not; this is only done once, and these arrays are needed -! through most of the a2d and d2a programs. allocate( lons( nlon )) allocate( lats( nlat )) allocate( levs( nlev )) @@ -451,7 +445,6 @@ function read_aether_time(filename) call nc_close_file(ncid, routine, filename) ! Calculate the DART time of the file time. -! TODO: review calculation of ndays in read_aether_time ndays = tsimulation / 86400 nsecs = tsimulation - (ndays * 86400) ! The ref day is not finished, but don't need to subtract 1 because @@ -502,8 +495,6 @@ function aether_name_to_dart(varname) var_root = aether(char_num+1:aether_len) ! purge_chars removes unwanted [()\] parts(1) = purge_chars( trim(var_root),')(\', plus_minus=.true.) -! TODO: keep aether_name_to_dart diagnostic? Then add routine, error_handler. -! print*,'var_root, parts(1) = ', var_root, parts(1) end_str = char_num ! Tranform remaining pieces of varname into DART versions. From 755db9bc5423d12a8c2f369af158d15a84e2e64b Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 6 Feb 2024 13:12:24 -0700 Subject: [PATCH 092/124] Updated namelist files; more consistent, better comments --- models/aether_lon-lat/model_mod.nml | 34 ++--- models/aether_lon-lat/transform_state.nml | 42 +++--- models/aether_lon-lat/work/input.nml | 154 ++++++++++------------ 3 files changed, 108 insertions(+), 122 deletions(-) diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index 473d160e98..33142734b0 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -6,21 +6,25 @@ time_step_days = 0 time_step_seconds = 3600 / - -! >>> Don't code these until we get new CF-compliant field names from Aaron. <<< -! >>> Not all fields have halos suitable for calculating gradients. These do (2023-11-8): -! neutral temperature, O, O2, N2, and the horizontal winds. -! The current model_mod will fill all halos anyway, since that's simpler and won't break the model. -! Other neutrals from restart files, which Aaron identified as important: - Zonal\ Wind - Meridional\ Wind -! Other ions from restart files, which Aaron identified as important: - O2+ - O+2D - O+2P - N2+ -! Other neutrals - Vertical\ Wind +! Aether ion variable names need transformation for DART into (O+ example): + Opos QTY_DENSITY_ION_OP + Opos_Temperature + Opos_velocity_parallel_east + Opos_velocity_parallel_north + Opos_velocity_parallel_up + Opos_velocity_perp_east + Opos_velocity_perp_north + Opos_velocity_perp_up +! Other variables + velocity_up QTY_VERTICAL_VELOCITY + O2pos QTY_DENSITY_ION_O2P + N2pos QTY_DENSITY_ION_N2P ? + O2pos_2D QTY_DENSITY_ION_O2DP ? + O2pos_2P QTY_DENSITY_ION_O2PP ? + NOpos + Npos + Hepos +! See ./issue_QTYs for complete lists of variables and potential QTYs Future?: x estimate_f10_7 = .false. diff --git a/models/aether_lon-lat/transform_state.nml b/models/aether_lon-lat/transform_state.nml index 0eea641d76..26f9d1c609 100644 --- a/models/aether_lon-lat/transform_state.nml +++ b/models/aether_lon-lat/transform_state.nml @@ -3,32 +3,28 @@ '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' variables = 'Temperature', 'neutrals', - 'velocity_east', 'neutrals', - 'O+', 'ions', - 'Temperature\ \(O+\)', 'ions', - 'velocity_parallel_east\ \(O+\)', 'ions', - 'velocity_parallel_north\ \(O+\)','ions', - 'velocity_parallel_up\ \(O+\)', 'ions', - 'velocity_perp_east\ \(O+\)', 'ions', - 'velocity_perp_north\ \(O+\)', 'ions', - 'velocity_perp_up\ \(O+\)', 'ions', + 'O+', 'ions', nblocks_lon = 2 nblocks_lat = 2 nblocks_lev = 1 debug = 0 / ! Neutrals from restart files, which Aaron identified as important: - Temperature QTY_TEMPERATURE - velocity_east QTY_U_WIND_COMPONENT - velocity_north QTY_V_WIND_COMPONENT - (velocity_up) QTY_VERTICAL_VELOCITY -! Ions from restart files, which Aaron identified as important: - O+ QTY_DENSITY_ION_OP - O2+ QTY_DENSITY_ION_O2P - O+2D QTY_DENSITY_ION_O2DP ? - O+2P QTY_DENSITY_ION_O2PP ? - N2+ QTY_DENSITY_ION_N2P ? - -See ./issue_QTYs for complete lists of variables and potential QTYs - - + Temperature + velocity_east + velocity_north +! Ion densities from restart files, which Aaron identified as important: + O+ + O2+ + O+_2D + O+_2P + N2+ +! Other variables + velocity_up 'neutrals + Velocity components of the ions, e.g. + 'velocity_perp_east\ \(O+\)', 'ions', + 'velocity_perp_north\ \(O+\)', 'ions', + 'velocity_perp_up\ \(O+\)', 'ions', + 'velocity_parallel_east\ \(O+\)', 'ions', + 'velocity_parallel_north\ \(O+\)','ions', + 'velocity_parallel_up\ \(O+\)', 'ions', diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index 59ccf5d278..64058c2306 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -117,96 +117,82 @@ print_every_nth_obs = 0 / -# Each variable must have 6 entries. -# 1: variable name -# 2: DART KIND -# 3: minimum value - as a character string - if none, use 'NA' -# 4: maximum value - as a character string - if none, use 'NA' -# 5: which aether netcdf file contains the variable - neutrals or ions -# All neutrals must be listed before the ions. -# 6: does the updated variable -# 'UPDATE' => updated variable written to file -# 'NO_COPY_BACK' => variable not written to file -# all these variables will be updated INTERNALLY IN DART. -# +! transform state +! Each variable must have 2 entries. +! 1: Aether variable name from {neutrals,ions}_mMMMM_gBBBB.nc +! 2: which aether netcdf file contains the variable - neutrals or ions +! All neutrals must be listed before the ions. + +&transform_state_nml + aether_restart_dirname = + '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' + variables = + 'Temperature', 'neutrals', + 'O+', 'ions', + nblocks_lon = 2 + nblocks_lat = 2 + nblocks_lev = 1 + debug = 0 + / +! Neutrals from restart files, which Aaron identified as important: + Temperature + velocity_east + velocity_north +! Ion densities from restart files, which Aaron identified as important: + O+ + O2+ + O+_2D + O+_2P + N2+ +! Other variables + velocity_up 'neutrals + Velocity components of the ions, e.g. + 'velocity_perp_east\ \(O+\)', 'ions', + 'velocity_perp_north\ \(O+\)', 'ions', + 'velocity_perp_up\ \(O+\)', 'ions', + 'velocity_parallel_east\ \(O+\)', 'ions', + 'velocity_parallel_north\ \(O+\)','ions', + 'velocity_parallel_up\ \(O+\)', 'ions', + +! model_mod +! Each variable must have 5 entries. +! 1: CF-compliant variable name found in filter_input_####.nc +! 2: DART KIND (QTY) +! 3: minimum value - as a character string - if none, use 'NA' +! 4: maximum value - as a character string - if none, use 'NA' +! 5: does the updated variable need to be written to the restart files? +! 'UPDATE' => updated variable written to file +! 'anything else' => variable not written to file +! all these variables will be updated INTERNALLY IN DART. &model_nml filter_io_filename = 'filter_input_0001.nc' - variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', - 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' - time_step_days = 0 + variables = + 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', + 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' + time_step_days = 0 time_step_seconds = 3600 debug = 10 / -! The most CF-compliant field names we'll get from Aaron are transformed for DART into: - velocity_east (U component of neutral wind) - Opos_velocity_parallel_east - Opos_velocity_parallel_north - Opos_velocity_parallel_up - Opos_velocity_perp_east - Opos_velocity_perp_north - Opos_velocity_perp_up -! Other neutrals from restart files, which Aaron identified as important: - Zonal\ Wind - Meridional\ Wind -! Other ions from restart files, which Aaron identified as important: - O2+ - O+2D - O+2P - N2+ -! Other neutrals - Vertical\ Wind - -&aether_to_dart_nml - aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' - filter_io_root = 'filter_input' - variables = - 'Temperature', 'QTY_TEMPERATURE', 'NA', '10000.0', 'neutrals', 'UPDATE', - 'velocity_east', 'QTY_U_WIND_COMPONENT' '1000.0', 'NA', 'neutrals', 'UPDATE', - 'O+', - 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' - 'Temperature\ \(O+\)', - 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_east\ \(O+\)', - 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_north\ \(O+\)', - 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_up\ \(O+\)', - 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_east\ \(O+\)', - 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_north\ \(O+\)', - 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_up\ \(O+\)', - 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' - debug = 5 - / - -&dart_to_aether_nml - aether_restart_dirname = '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' - filter_io_root = 'filter_output', - variables = - 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'neutrals', 'UPDATE', - 'velocity_east' 'QTY_U_WIND_COMPONENT' '1000.0', 'NA', 'neutrals', 'UPDATE', - 'O+', - 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'ions', 'UPDATE' - 'Temperature (O+)', - 'QTY_TEMPERATURE_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_east (O+)', - 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_north (O+)', - 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_parallel_up (O+)', - 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_east (O+)', - 'QTY_VELOCITY_U_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_north (O+)', - 'QTY_VELOCITY_V_ION', 'NA', 'NA', 'ions', 'UPDATE', - 'velocity_perp_up (O+)', - 'QTY_VELOCITY_W_ION', 'NA', 'NA', 'ions', 'UPDATE' - debug = 5 - / -! 4 digit member number and .nc will be appended to this. +! Aether ion variable names need transformation for DART into (O+ example): + Opos QTY_DENSITY_ION_OP + Opos_Temperature + Opos_velocity_parallel_east + Opos_velocity_parallel_north + Opos_velocity_parallel_up + Opos_velocity_perp_east + Opos_velocity_perp_north + Opos_velocity_perp_up +! Other variables + velocity_up QTY_VERTICAL_VELOCITY + O2pos QTY_DENSITY_ION_O2P + N2pos QTY_DENSITY_ION_N2P ? + O2pos_2D QTY_DENSITY_ION_O2DP ? + O2pos_2P QTY_DENSITY_ION_O2PP ? + NOpos + Npos + Hepos +! See ./issue_QTYs for complete lists of variables and potential QTYs &cov_cutoff_nml select_localization = 1 From def4a2ea7dff73e7992acf83f4affd07849008d5 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Tue, 6 Feb 2024 13:12:26 -0700 Subject: [PATCH 093/124] Update aether model_mod to move indices for variable table to the assign_var function --- models/aether_lon-lat/model_mod.f90 | 30 ++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index a9404b7099..f376e419fd 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -118,14 +118,6 @@ module model_mod namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables -!----------------------------------------------------------------------- -! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table -integer, parameter :: VT_VARNAMEINDX = 1 ! ... variable name -integer, parameter :: VT_KINDINDX = 2 ! ... DART kind -integer, parameter :: VT_MINVALINDX = 3 ! ... minimum value if any -integer, parameter :: VT_MAXVALINDX = 4 ! ... maximum value if any -integer, parameter :: VT_STATEINDX = 5 ! ... update (state) or not - !----------------------------------------------------------------------- ! Dimensions @@ -510,6 +502,14 @@ function assign_var(variables, MAX_STATE_VARIABLES) result(var) integer :: ivar + !----------------------------------------------------------------------- + ! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table + integer, parameter :: NAME_INDEX = 1 ! ... variable name + integer, parameter :: QTY_INDEX = 2 ! ... DART kind + integer, parameter :: MIN_VAL_INDEX = 3 ! ... minimum value if any + integer, parameter :: MAX_VAL_INDEX = 4 ! ... maximum value if any + integer, parameter :: UPDATE_INDEX = 5 ! ... update (state) or not + ! Loop through the variables array to get the actual count of the number of variables do ivar = 1, MAX_STATE_VARIABLES ! If the element is an empty string, the loop has exceeded the extent of the variables @@ -524,23 +524,23 @@ function assign_var(variables, MAX_STATE_VARIABLES) result(var) do ivar = 1, var%count - var%names(ivar) = trim(variables(1, ivar)) + var%names(ivar) = trim(variables(NAME_INDEX, ivar)) - var%qtys(ivar) = get_index_for_quantity(variables(2, ivar)) + var%qtys(ivar) = get_index_for_quantity(variables(QTY_INDEX, ivar)) - if (variables(3, ivar) /= 'NA') then - read(variables(3, ivar), '(d16.8)') var%clamp_values(ivar,1) + if (variables(MIN_VAL_INDEX, ivar) /= 'NA') then + read(variables(MIN_VAL_INDEX, ivar), '(d16.8)') var%clamp_values(ivar,1) else var%clamp_values(ivar,1) = MISSING_R8 endif - if (variables(4, ivar) /= 'NA') then - read(variables(4, ivar), '(d16.8)') var%clamp_values(ivar,2) + if (variables(MAX_VAL_INDEX, ivar) /= 'NA') then + read(variables(MAX_VAL_INDEX, ivar), '(d16.8)') var%clamp_values(ivar,2) else var%clamp_values(ivar,2) = MISSING_R8 endif - if (variables(5, ivar) == 'UPDATE') then + if (variables(UPDATE_INDEX, ivar) == 'UPDATE') then var%updates(ivar) = .true. else var%updates(ivar) = .false. From 3e5e1c13871398d0a40c4d5eab26f992d98afadd Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Tue, 6 Feb 2024 15:24:16 -0700 Subject: [PATCH 094/124] Update aether model_mod and input.nml to omit debug error messages --- models/aether_lon-lat/model_mod.f90 | 20 ++------------------ models/aether_lon-lat/work/input.nml | 11 +++++------ 2 files changed, 7 insertions(+), 24 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index f376e419fd..2a41b004da 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -100,7 +100,6 @@ module model_mod character(len=256) :: filter_io_filename = 'filter_input_0001.nc' integer :: time_step_days = 0 integer :: time_step_seconds = 3600 -integer :: debug = 0 integer, parameter :: MAX_STATE_VARIABLES = 100 integer, parameter :: NUM_STATE_TABLE_COLUMNS = 5 @@ -116,7 +115,7 @@ module model_mod type(var_type) :: var -namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables +namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, variables !----------------------------------------------------------------------- ! Dimensions @@ -265,11 +264,6 @@ subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs lvert = loc_array(3) which_vert = nint(query_location(location)) -IF (debug > 85) then - write(error_string_1,'(A,3F15.4)') 'requesting interpolation at ', llon, llat, lvert - call error_handler(E_MSG, routine, error_string_1, source) -end if - ! Only height and level for vertical location type is supported at this point if (.not. is_vertical(location, "HEIGHT") .and. .not. is_vertical(location, "LEVEL")) THEN istatus = INVALID_VERT_COORD_ERROR_CODE @@ -289,16 +283,7 @@ subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs ! do we know how to interpolate this quantity? call ok_to_interpolate(qty, varid, status1) - -if (status1 /= 0) then - if(debug > 12) then - write(error_string_1,'(A,I5,A)') 'Did not find observation quantity ', qty, & - ' in the state vector' - call error_handler(E_WARN, routine, error_string_1, source) - endif - istatus(:) = status1 ! this quantity not in the state vector - return -endif +istatus = status1 ! get the indices for the 4 corners of the quad in the horizontal, plus ! the fraction across the quad for the obs location @@ -443,7 +428,6 @@ subroutine nc_write_model_atts(ncid, domain_id) ! OR NOT, if called by create_and_open_state_output call nc_begin_define_mode(ncid) -! Debug global att creation time; This requires being in define mode. ! nc_write_model_atts is called by create_and_open_state_output, ! which calls nf90_enddef before it. call nc_add_global_creation_time(ncid, routine) diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index 64058c2306..bd4ca254c6 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -167,13 +167,12 @@ &model_nml filter_io_filename = 'filter_input_0001.nc' - variables = - 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', - 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' - time_step_days = 0 - time_step_seconds = 3600 - debug = 10 + variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', + 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' + time_step_days = 0 + time_step_seconds = 3600 / + ! Aether ion variable names need transformation for DART into (O+ example): Opos QTY_DENSITY_ION_OP Opos_Temperature From ad0c1962418e0a51be328072aa2c3e95d17e907e Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Wed, 7 Feb 2024 08:10:22 -0700 Subject: [PATCH 095/124] Omit associative renaming of get_close_obs and get_close_state in aether model mod and remove their redundant implementations --- models/aether_lon-lat/model_mod.f90 | 53 +---------------------------- 1 file changed, 1 insertion(+), 52 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 2a41b004da..96dd811fd1 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -19,8 +19,7 @@ module model_mod use location_mod, only : & location_type, get_close_type, & - loc_get_close_obs => get_close_obs, & - loc_get_close_state => get_close_state, & + get_close_obs, get_close_state, & is_vertical, set_location, & VERTISHEIGHT, query_location, get_location @@ -354,56 +353,6 @@ subroutine get_state_meta_data(index_in, location, qty) end subroutine get_state_meta_data - -!----------------------------------------------------------------------- -! Any model specific distance calcualtion can be done here - -subroutine get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & - num_close, close_ind, dist, ens_handle) - -type(get_close_type), intent(in) :: gc ! handle to a get_close structure -integer, intent(in) :: base_type ! observation TYPE -type(location_type), intent(inout) :: base_loc ! location of interest -type(location_type), intent(inout) :: locs(:) ! obs locations -integer, intent(in) :: loc_qtys(:) ! QTYS for obs -integer, intent(in) :: loc_types(:) ! TYPES for obs -integer, intent(out) :: num_close ! how many are close -integer, intent(out) :: close_ind(:) ! incidies into the locs array -real(r8), optional, intent(out) :: dist(:) ! distances in radians -type(ensemble_type), optional, intent(in) :: ens_handle - -! character(len=*), parameter :: routine = 'get_close_obs' - -call loc_get_close_obs(gc, base_loc, base_type, locs, loc_qtys, loc_types, & - num_close, close_ind, dist, ens_handle) - -end subroutine get_close_obs - -!----------------------------------------------------------------------- -! Any model specific distance calcualtion can be done here - -subroutine get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & - num_close, close_ind, dist, ens_handle) - -type(get_close_type), intent(in) :: gc ! handle to a get_close structure -type(location_type), intent(inout) :: base_loc ! location of interest -integer, intent(in) :: base_type ! observation TYPE -type(location_type), intent(inout) :: locs(:) ! state locations -integer, intent(in) :: loc_qtys(:) ! QTYs for state -integer(i8), intent(in) :: loc_indx(:) ! indices into DART state vector -integer, intent(out) :: num_close ! how many are close -integer, intent(out) :: close_ind(:) ! indices into the locs array -real(r8), optional, intent(out) :: dist(:) ! distances in radians -type(ensemble_type), optional, intent(in) :: ens_handle - -! character(len=*), parameter :: routine = 'get_close_state' - - -call loc_get_close_state(gc, base_loc, base_type, locs, loc_qtys, loc_indx, & - num_close, close_ind, dist, ens_handle) - -end subroutine get_close_state - !----------------------------------------------------------------------- ! Does any shutdown and clean-up needed for model. Can be a NULL ! INTERFACE if the model has no need to clean up storage, etc. From ea02b4e72a4e1979acbe073f622bda1c4822d237 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Wed, 7 Feb 2024 08:23:37 -0700 Subject: [PATCH 096/124] Change aether namelist references from filter_io_filename to template_filename --- models/aether_lon-lat/aether_to_dart.f90 | 10 +++++----- models/aether_lon-lat/dart_to_aether.f90 | 8 ++++---- models/aether_lon-lat/model_mod.f90 | 16 ++++++++-------- models/aether_lon-lat/model_mod.nml | 2 +- models/aether_lon-lat/readme.rst | 2 +- models/aether_lon-lat/transform_state_mod.f90 | 6 +++--- models/aether_lon-lat/work/input.nml | 2 +- 7 files changed, 23 insertions(+), 23 deletions(-) diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lon-lat/aether_to_dart.f90 index bcd0fe203f..d083b713fe 100644 --- a/models/aether_lon-lat/aether_to_dart.f90 +++ b/models/aether_lon-lat/aether_to_dart.f90 @@ -50,7 +50,7 @@ program aether_to_dart num_args, ncid character(len=3) :: char_mem character(len=31) :: filter_io_root = 'filter_input' -character(len=64) :: filter_io_filename = '' +character(len=64) :: template_filename = '' character(len=512) :: error_string_1, error_string_2 character(len=31), parameter :: progname = 'aether_to_dart' character(len=256), parameter :: source = 'aether_lon-lat/aether_to_dart.f90' @@ -88,16 +88,16 @@ program aether_to_dart call static_init_blocks() ! Must be after static_init_blocks, which provides filter_io_root from the namelist. -write(filter_io_filename,'(2A, I0.4, A3)') trim(filter_io_root),'_', member + 1,'.nc' +write(template_filename,'(2A, I0.4, A3)') trim(filter_io_root),'_', member + 1,'.nc' call error_handler(E_MSG, '', '') write(error_string_1,'(A,I3,2A)') 'Converting Aether member ',member, & - ' restart files to the NetCDF file ', trim(filter_io_filename) + ' restart files to the NetCDF file ', trim(template_filename) write(error_string_2,'(3A)') ' in directory ', trim(aether_restart_dirname) call error_handler(E_MSG, progname, error_string_1, text2=error_string_2) call error_handler(E_MSG, '', '') ! nc_create_file does not leave define mode. -ncid = nc_create_file(filter_io_filename) +ncid = nc_create_file(template_filename) ! def_fill_dimvars does leave define mode. call def_fill_dimvars(ncid) @@ -115,7 +115,7 @@ program aether_to_dart call error_handler(E_MSG, '', '') write(error_string_1,'(3A)') 'Successfully converted the Aether restart files to ', & - "'"//trim(filter_io_filename)//"'" + "'"//trim(template_filename)//"'" call error_handler(E_MSG, progname, error_string_1) call error_handler(E_MSG, '', '') diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lon-lat/dart_to_aether.f90 index ce210be5c0..f6111d8dce 100644 --- a/models/aether_lon-lat/dart_to_aether.f90 +++ b/models/aether_lon-lat/dart_to_aether.f90 @@ -46,7 +46,7 @@ program dart_to_aether num_args, ncid character(len=3) :: char_mem character(len=31) :: filter_io_root = 'filter_input' -character(len=64) :: filter_io_filename = '' +character(len=64) :: template_filename = '' character(len=512) :: error_string_1, error_string_2 character(len=31), parameter :: progname = 'dart_to_aether' character(len=256), parameter :: source = 'aether_lon-lat/dart_to_aether..f90' @@ -73,15 +73,15 @@ program dart_to_aether call static_init_blocks() -write(filter_io_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member + 1,'.nc' +write(template_filename,'(2A,I0.4,A3)') trim(filter_io_root),'_',member + 1,'.nc' call error_handler(E_MSG, source, '', '') -write(error_string_1,'(3A)') 'Extracting fields from DART file ',trim(filter_io_filename) +write(error_string_1,'(3A)') 'Extracting fields from DART file ',trim(template_filename) write(error_string_2,'(A,I3,2A)') 'into Aether restart member ',member,' in directory ', trim(aether_restart_dirname) call error_handler(E_MSG, progname, error_string_1, text2=error_string_2) call error_handler(E_MSG, '', '') -ncid = nc_open_file_readonly(filter_io_filename, source) +ncid = nc_open_file_readonly(template_filename, source) call filter_to_restarts(ncid, member) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 96dd811fd1..44f23d079a 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -96,7 +96,7 @@ module model_mod !----------------------------------------------------------------------- ! Default values for namelist -character(len=256) :: filter_io_filename = 'filter_input_0001.nc' +character(len=256) :: template_filename = 'filter_input_0001.nc' integer :: time_step_days = 0 integer :: time_step_seconds = 3600 @@ -114,7 +114,7 @@ module model_mod type(var_type) :: var -namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, variables +namelist /model_nml/ template_filename, time_step_days, time_step_seconds, variables !----------------------------------------------------------------------- ! Dimensions @@ -176,7 +176,7 @@ subroutine static_init_model() call set_calendar_type(calendar) -call assign_dimensions(filter_io_filename) +call assign_dimensions(template_filename) ! Dimension start and deltas needed for set_quad_coords lon_start = lons(1) @@ -195,7 +195,7 @@ subroutine static_init_model() ! Define which variables are in the model state ! This is using add_domain_from_file (arg list matches) -dom_id = add_domain(filter_io_filename, var%count, var%names, var%qtys, & +dom_id = add_domain(template_filename, var%count, var%names, var%qtys, & var%clamp_values, var%updates) call state_structure_info(dom_id) @@ -395,16 +395,16 @@ end subroutine nc_write_model_atts ! Read dimension information from the template file and use ! it to assign values to variables. -subroutine assign_dimensions(filter_io_filename) +subroutine assign_dimensions(template_filename) -character(len=*), intent(in) :: filter_io_filename +character(len=*), intent(in) :: template_filename integer :: ncid character(len=24), parameter :: routine = 'assign_dimensions' -call error_handler(E_MSG, routine, 'reading filter input ['//trim(filter_io_filename)//']') +call error_handler(E_MSG, routine, 'reading filter input ['//trim(template_filename)//']') -ncid = nc_open_file_readonly(filter_io_filename, routine) +ncid = nc_open_file_readonly(template_filename, routine) ! levels nlev = nc_get_dimension_size(ncid, trim(LEV_DIM_NAME), routine) diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lon-lat/model_mod.nml index 33142734b0..33358e2be5 100644 --- a/models/aether_lon-lat/model_mod.nml +++ b/models/aether_lon-lat/model_mod.nml @@ -1,5 +1,5 @@ &model_nml - filter_io_filename = 'if other than filter_input_0001.nc' + template_filename = 'if other than filter_input_0001.nc' debug = 0 variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'UPDATE', 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' diff --git a/models/aether_lon-lat/readme.rst b/models/aether_lon-lat/readme.rst index 5773cef391..4c05d1b0a5 100644 --- a/models/aether_lon-lat/readme.rst +++ b/models/aether_lon-lat/readme.rst @@ -105,7 +105,7 @@ transform_state_nml model_nml ......... -filter_io_filename +template_filename = 'if other than filter_input_0001.nc' variables diff --git a/models/aether_lon-lat/transform_state_mod.f90 b/models/aether_lon-lat/transform_state_mod.f90 index c1b9b49cb3..35eac3a9e9 100644 --- a/models/aether_lon-lat/transform_state_mod.f90 +++ b/models/aether_lon-lat/transform_state_mod.f90 @@ -116,7 +116,7 @@ module transform_state_mod subroutine static_init_blocks() -character(len=128) :: aether_filter_io_filename +character(len=128) :: aether_template_filename integer :: iunit, io character(len=*), parameter :: routine = 'static_init_blocks' @@ -163,8 +163,8 @@ subroutine static_init_blocks() call get_time(aether_ref_time, aether_ref_nsecs, aether_ref_ndays) ! Get the model time from a restart file. -aether_filter_io_filename = block_file_name(variables(VT_ORIGININDX,1), 0, 0) -state_time = read_aether_time(trim(aether_restart_dirname)//'/'//trim(aether_filter_io_filename)) +aether_template_filename = block_file_name(variables(VT_ORIGININDX,1), 0, 0) +state_time = read_aether_time(trim(aether_restart_dirname)//'/'//trim(aether_template_filename)) if ( debug > 0 ) then write(error_string_1,'("grid: nlon, nlat, nlev =",3(1x,i5))') nlon, nlat, nlev diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lon-lat/work/input.nml index bd4ca254c6..c50df1267f 100644 --- a/models/aether_lon-lat/work/input.nml +++ b/models/aether_lon-lat/work/input.nml @@ -166,7 +166,7 @@ ! all these variables will be updated INTERNALLY IN DART. &model_nml - filter_io_filename = 'filter_input_0001.nc' + template_filename = 'filter_input_0001.nc' variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' time_step_days = 0 From 91dfadbc78225ce53ab411b6dbc12be54c23d6cb Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Wed, 7 Feb 2024 08:43:46 -0700 Subject: [PATCH 097/124] Remove references to QTY_GEOMETRIC_HEIGHT and delete ok_to_interpolate subroutine in aether model_mod --- models/aether_lon-lat/model_mod.f90 | 53 +++++------------------------ 1 file changed, 8 insertions(+), 45 deletions(-) diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lon-lat/model_mod.f90 index 44f23d079a..5c9be8ed98 100644 --- a/models/aether_lon-lat/model_mod.f90 +++ b/models/aether_lon-lat/model_mod.f90 @@ -30,7 +30,7 @@ module model_mod find_namelist_in_file, check_namelist_read, to_upper, & find_enclosing_indices -use obs_kind_mod, only : get_index_for_quantity, QTY_GEOMETRIC_HEIGHT +use obs_kind_mod, only : get_index_for_quantity use netcdf_utilities_mod, only : & nc_add_global_attribute, nc_synchronize_file, & @@ -269,20 +269,14 @@ subroutine model_interpolate(state_handle, ens_size, location, qty, expected_obs return endif -if (qty == QTY_GEOMETRIC_HEIGHT .and. is_vertical(location, "LEVEL")) then - if (nint(lvert) < 1 .or. nint(lvert) > size(levs,1)) then - expected_obs = MISSING_R8 - istatus = 1 - else - expected_obs = levs(nint(lvert)) - istatus = 0 - endif - return ! Early Return -endif +! See if the state contains the obs quantity +varid = get_varid_from_kind(dom_id, qty) -! do we know how to interpolate this quantity? -call ok_to_interpolate(qty, varid, status1) -istatus = status1 +if (varid > 0) then + istatus = 0 +else + istatus = UNKNOWN_OBS_QTY_ERROR_CODE +endif ! get the indices for the 4 corners of the quad in the horizontal, plus ! the fraction across the quad for the obs location @@ -623,37 +617,6 @@ subroutine get_four_state_values(state_handle, ens_size, four_lons, four_lats, & end subroutine get_four_state_values -!----------------------------------------------------------------------- -! 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 - -subroutine ok_to_interpolate(qty, varid, istatus) - -integer, intent(in) :: qty -integer, intent(out) :: varid -integer, intent(out) :: istatus - -! See if the state contains the obs quantity -varid = get_varid_from_kind(dom_id, qty) - -! in the state vector -if (varid > 0) then - istatus = 0 - return -endif - -! add any quantities that can be interpolated to this list if they -! are not in the state vector. -select case (qty) - case (QTY_GEOMETRIC_HEIGHT) - istatus = 0 - case default - istatus = UNKNOWN_OBS_QTY_ERROR_CODE -end select - -end subroutine ok_to_interpolate - !----------------------------------------------------------------------- ! End of model_mod !----------------------------------------------------------------------- From 608b87f0b17efafb76d1c99106d1d5d6f2dd74d4 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Wed, 7 Feb 2024 19:59:20 -0700 Subject: [PATCH 098/124] Moved aether_lon-lat to aether_lat-lon. Files unchanged --- models/{aether_lon-lat => aether_lat-lon}/aether_to_dart.f90 | 0 models/{aether_lon-lat => aether_lat-lon}/dart_to_aether.f90 | 0 models/{aether_lon-lat => aether_lat-lon}/issue_QTYs | 0 .../{aether_lon-lat => aether_lat-lon}/matlab/new_varname_file.m | 0 models/{aether_lon-lat => aether_lat-lon}/model_mod.f90 | 0 models/{aether_lon-lat => aether_lat-lon}/model_mod.nml | 0 models/{aether_lon-lat => aether_lat-lon}/readme.rst | 0 models/{aether_lon-lat => aether_lat-lon}/transform_state.nml | 0 models/{aether_lon-lat => aether_lat-lon}/transform_state_mod.f90 | 0 models/{aether_lon-lat => aether_lat-lon}/work/filter_inputs.txt | 0 models/{aether_lon-lat => aether_lat-lon}/work/filter_outputs.txt | 0 models/{aether_lon-lat => aether_lat-lon}/work/input.nml | 0 models/{aether_lon-lat => aether_lat-lon}/work/obs_seq.out.1 | 0 models/{aether_lon-lat => aether_lat-lon}/work/quickbuild.sh | 0 14 files changed, 0 insertions(+), 0 deletions(-) rename models/{aether_lon-lat => aether_lat-lon}/aether_to_dart.f90 (100%) rename models/{aether_lon-lat => aether_lat-lon}/dart_to_aether.f90 (100%) rename models/{aether_lon-lat => aether_lat-lon}/issue_QTYs (100%) rename models/{aether_lon-lat => aether_lat-lon}/matlab/new_varname_file.m (100%) rename models/{aether_lon-lat => aether_lat-lon}/model_mod.f90 (100%) rename models/{aether_lon-lat => aether_lat-lon}/model_mod.nml (100%) rename models/{aether_lon-lat => aether_lat-lon}/readme.rst (100%) rename models/{aether_lon-lat => aether_lat-lon}/transform_state.nml (100%) rename models/{aether_lon-lat => aether_lat-lon}/transform_state_mod.f90 (100%) rename models/{aether_lon-lat => aether_lat-lon}/work/filter_inputs.txt (100%) rename models/{aether_lon-lat => aether_lat-lon}/work/filter_outputs.txt (100%) rename models/{aether_lon-lat => aether_lat-lon}/work/input.nml (100%) rename models/{aether_lon-lat => aether_lat-lon}/work/obs_seq.out.1 (100%) rename models/{aether_lon-lat => aether_lat-lon}/work/quickbuild.sh (100%) diff --git a/models/aether_lon-lat/aether_to_dart.f90 b/models/aether_lat-lon/aether_to_dart.f90 similarity index 100% rename from models/aether_lon-lat/aether_to_dart.f90 rename to models/aether_lat-lon/aether_to_dart.f90 diff --git a/models/aether_lon-lat/dart_to_aether.f90 b/models/aether_lat-lon/dart_to_aether.f90 similarity index 100% rename from models/aether_lon-lat/dart_to_aether.f90 rename to models/aether_lat-lon/dart_to_aether.f90 diff --git a/models/aether_lon-lat/issue_QTYs b/models/aether_lat-lon/issue_QTYs similarity index 100% rename from models/aether_lon-lat/issue_QTYs rename to models/aether_lat-lon/issue_QTYs diff --git a/models/aether_lon-lat/matlab/new_varname_file.m b/models/aether_lat-lon/matlab/new_varname_file.m similarity index 100% rename from models/aether_lon-lat/matlab/new_varname_file.m rename to models/aether_lat-lon/matlab/new_varname_file.m diff --git a/models/aether_lon-lat/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 similarity index 100% rename from models/aether_lon-lat/model_mod.f90 rename to models/aether_lat-lon/model_mod.f90 diff --git a/models/aether_lon-lat/model_mod.nml b/models/aether_lat-lon/model_mod.nml similarity index 100% rename from models/aether_lon-lat/model_mod.nml rename to models/aether_lat-lon/model_mod.nml diff --git a/models/aether_lon-lat/readme.rst b/models/aether_lat-lon/readme.rst similarity index 100% rename from models/aether_lon-lat/readme.rst rename to models/aether_lat-lon/readme.rst diff --git a/models/aether_lon-lat/transform_state.nml b/models/aether_lat-lon/transform_state.nml similarity index 100% rename from models/aether_lon-lat/transform_state.nml rename to models/aether_lat-lon/transform_state.nml diff --git a/models/aether_lon-lat/transform_state_mod.f90 b/models/aether_lat-lon/transform_state_mod.f90 similarity index 100% rename from models/aether_lon-lat/transform_state_mod.f90 rename to models/aether_lat-lon/transform_state_mod.f90 diff --git a/models/aether_lon-lat/work/filter_inputs.txt b/models/aether_lat-lon/work/filter_inputs.txt similarity index 100% rename from models/aether_lon-lat/work/filter_inputs.txt rename to models/aether_lat-lon/work/filter_inputs.txt diff --git a/models/aether_lon-lat/work/filter_outputs.txt b/models/aether_lat-lon/work/filter_outputs.txt similarity index 100% rename from models/aether_lon-lat/work/filter_outputs.txt rename to models/aether_lat-lon/work/filter_outputs.txt diff --git a/models/aether_lon-lat/work/input.nml b/models/aether_lat-lon/work/input.nml similarity index 100% rename from models/aether_lon-lat/work/input.nml rename to models/aether_lat-lon/work/input.nml diff --git a/models/aether_lon-lat/work/obs_seq.out.1 b/models/aether_lat-lon/work/obs_seq.out.1 similarity index 100% rename from models/aether_lon-lat/work/obs_seq.out.1 rename to models/aether_lat-lon/work/obs_seq.out.1 diff --git a/models/aether_lon-lat/work/quickbuild.sh b/models/aether_lat-lon/work/quickbuild.sh similarity index 100% rename from models/aether_lon-lat/work/quickbuild.sh rename to models/aether_lat-lon/work/quickbuild.sh From edc55ab6b037863470dfe112748c3e1f664eb7b9 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Wed, 7 Feb 2024 20:22:34 -0700 Subject: [PATCH 099/124] Finished lon-lat to lat-lon conversion; file contents --- models/aether_lat-lon/aether_to_dart.f90 | 2 +- models/aether_lat-lon/dart_to_aether.f90 | 2 +- models/aether_lat-lon/model_mod.f90 | 2 +- models/aether_lat-lon/readme.rst | 4 ++-- models/aether_lat-lon/transform_state.nml | 2 +- models/aether_lat-lon/transform_state_mod.f90 | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) diff --git a/models/aether_lat-lon/aether_to_dart.f90 b/models/aether_lat-lon/aether_to_dart.f90 index bcd0fe203f..b6e89428ce 100644 --- a/models/aether_lat-lon/aether_to_dart.f90 +++ b/models/aether_lat-lon/aether_to_dart.f90 @@ -53,7 +53,7 @@ program aether_to_dart character(len=64) :: filter_io_filename = '' character(len=512) :: error_string_1, error_string_2 character(len=31), parameter :: progname = 'aether_to_dart' -character(len=256), parameter :: source = 'aether_lon-lat/aether_to_dart.f90' +character(len=256), parameter :: source = 'aether_lat-lon/aether_to_dart.f90' character(len=4), parameter :: LEV_DIM_NAME = 'alt' character(len=4), parameter :: LAT_DIM_NAME = 'lat' diff --git a/models/aether_lat-lon/dart_to_aether.f90 b/models/aether_lat-lon/dart_to_aether.f90 index ce210be5c0..674541e0c5 100644 --- a/models/aether_lat-lon/dart_to_aether.f90 +++ b/models/aether_lat-lon/dart_to_aether.f90 @@ -49,7 +49,7 @@ program dart_to_aether character(len=64) :: filter_io_filename = '' character(len=512) :: error_string_1, error_string_2 character(len=31), parameter :: progname = 'dart_to_aether' -character(len=256), parameter :: source = 'aether_lon-lat/dart_to_aether..f90' +character(len=256), parameter :: source = 'aether_lat-lon/dart_to_aether..f90' !====================================================================== diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index f376e419fd..3c178c7e02 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -89,7 +89,7 @@ module model_mod shortest_time_between_assimilations, & write_model_time -character(len=256), parameter :: source = 'aether_lon-lat/model_mod.f90' +character(len=256), parameter :: source = 'aether_lat-lon/model_mod.f90' logical :: module_initialized = .false. integer :: dom_id ! used to access the state structure diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index 5773cef391..694fc75206 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -5,9 +5,9 @@ Overview -------- The `Aether` ("eether") space weather model can be implemented -on a logically rectangular grid "lon-lat", +on a logically rectangular grid "lat-lon", or on an the cubed-sphere grid (see ../aether_cubed_shere). -This is the interface to the lon-lat version. +This is the interface to the lat-lon version. .. Aether: https://aetherdocumentation.readthedocs.io/en/latest/ diff --git a/models/aether_lat-lon/transform_state.nml b/models/aether_lat-lon/transform_state.nml index 26f9d1c609..e0f1ae021e 100644 --- a/models/aether_lat-lon/transform_state.nml +++ b/models/aether_lat-lon/transform_state.nml @@ -1,6 +1,6 @@ &transform_state_nml aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' + '/Users/raeder/DAI/Manhattan/models/aether_lat-lon/testdata3' variables = 'Temperature', 'neutrals', 'O+', 'ions', diff --git a/models/aether_lat-lon/transform_state_mod.f90 b/models/aether_lat-lon/transform_state_mod.f90 index c1b9b49cb3..2e57bc3abd 100644 --- a/models/aether_lat-lon/transform_state_mod.f90 +++ b/models/aether_lat-lon/transform_state_mod.f90 @@ -45,7 +45,7 @@ module transform_state_mod aether_restart_dirname, & purge_chars, debug -character(len=256), parameter :: source = 'aether_lon-lat/transform_state_mod.f90' +character(len=256), parameter :: source = 'aether_lat-lon/transform_state_mod.f90' logical :: module_initialized = .false. From 6aab8e0273efb9e923b1b754c17ebf0f12a056d4 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Wed, 7 Feb 2024 21:00:27 -0700 Subject: [PATCH 100/124] Applied recommendations from review #2. Name changes: model_mod.*; filter_io_filename -> domain_template_file Documentation: Moved comments out of *.nml into readme.rst. Moved content from issue_QTYs into readme.rst. Removed issue_QTYs. Added NOTEs and WARNINGs to readme.rst. Compiling and testing will be done after the next, functional changes. --- models/aether_lat-lon/issue_QTYs | 174 ---------------------- models/aether_lat-lon/model_mod.f90 | 25 ++-- models/aether_lat-lon/model_mod.nml | 25 +--- models/aether_lat-lon/readme.rst | 61 ++++++-- models/aether_lat-lon/transform_state.nml | 19 --- 5 files changed, 62 insertions(+), 242 deletions(-) delete mode 100644 models/aether_lat-lon/issue_QTYs diff --git a/models/aether_lat-lon/issue_QTYs b/models/aether_lat-lon/issue_QTYs deleted file mode 100644 index 96848beb75..0000000000 --- a/models/aether_lat-lon/issue_QTYs +++ /dev/null @@ -1,174 +0,0 @@ - -I'm confused by the selection of QTYs that can be associated -with the Aether variables. I made some choices in the early rush -to get something working, but now I'd like to figure out if they were good choices. -I don't even know how to decide whether it matters (much). - -My first problem is interpretting what the available QTY's represent. -I haven't found a key to decipher the parts of, e.g. QTY_DENSITY_ION_O2DP . -O2 could mean 'oxygen molecule', D could mean an extra or missing electron -from the D orbital, P could be similar, or mean 'positive'. -Or O could mean 'oxygen atom' with 2D or 2DP meaning something. -Comments in space_quantities_mod.f90 or in a docs.dart page would be helpful. - -The Aether variable 'velocity_parallel_up\ \(O+\)' -could potentially have these existing QTYs associated with it: -QTY_VELOCITY_W -QTY_VELOCITY_W_ION -QTY_VERTICAL_VELOCITY -or maybe it should have a new QTY like the existing QTY_VELOCITY_VERTICAL_O2: -QTY_VELOCITY_PARALLEL_VERTICAL_OP - ^ -Note; the size of these parameters may be limited to 31 (types_mod.f90) - Develop abbreviations? VELOCITY -> VEL - especially for easily recognized words, leaving more characters for - the unusal parts of the names. -This last seems safest, since each ion has its own 2 vertical velocities. -But I don't know how they'll be used, so maybe a simple, generic QTY -for all the ions is fine. - -2024-1 (final full set) Neutrals - Temperature, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2, - velocity_east, velocity_north, velocity_up - Temperature, - O - N - O2 QTY_DENSITY_NEUTRAL_O2 - N2 QTY_DENSITY_NEUTRAL_N2 - NO - He - N_2D - N_2P - H - O_1D - CO2 - Temperature ; QTY_TEMPERATURE - velocity_east ; QTY_U_WIND_COMPONENT - velocity_north ; QTY_V_WIND_COMPONENT - velocity_up ; QTY_VERTICAL_VELOCITY - -2024-1 (final full set) ions (e- is missing) - O+ - Temperature\ \(O+\) - velocity_parallel_east\ \(O+\) - velocity_parallel_north\ \(O+\) - velocity_parallel_up\ \(O+\) - velocity_perp_east\ \(O+\) - velocity_perp_north\ \(O+\) - velocity_perp_up\ \(O+\) - Repeat the associated vars for: - O2+ - N2+ - NO+ - N+ - He+ - O+_2D - O+_2P - Temperature_bulk_ion - Temperature_electron - - -! These were harvested from the obs_kind_mod.f90 created from - quantity_files = - '../../../assimilation_code/modules/observations/atmosphere_quantities_mod.f90', - '../../../assimilation_code/modules/observations/space_quantities_mod.f90', - '../../../assimilation_code/modules/observations/chemistry_quantities_mod.f90' -! There might be additional relevant QTYs in other quantities_mod.f90 - -! TODO: Or could use these. What's the difference? -! Would it be useful to use 1 type for Parallel and the other for Perp.? - QTY_VELOCITY_U - QTY_VELOCITY_V - QTY_VELOCITY_W - QTY_VERTICAL_VELOCITY - ... -! Note; there are QTYs available for vertical velocity for individual species. - QTY_VELOCITY_VERTICAL_O2 -! But not for the other components - -! or more specific QTYs (but maybe not a complete set?) -! There seems to be choice for for some chemicals, -! which will be guided by which -! assimilation_code/modules/observations/*quantities_mod.f90 -! defines them. -! The chosen files need to be added to the preprocess_nml. -! Full (assembled for my case by preprocess) list: -! (copy candidates to actual names, above) ---- -QTY_TEMPERATURE_ION -QTY_VELOCITY_U_ION -QTY_VELOCITY_V_ION -QTY_VELOCITY_W_ION ---- - -QTY_DENSITY_ION_E 0 -QTY_ELECTRON_DENSITY -QTY_TEMPERATURE_ELECTRON - -QTY_VERTICAL_TEC ---- -QTY_ATOMIC_OXYGEN_MIXING_RATIO -? QTY_DENSITY_NEUTRAL_O1D - -QTY_ION_O_MIXING_RATIO -QTY_DENSITY_ION_OP ---- -QTY_MOLEC_OXYGEN_MIXING_RATIO -QTY_DENSITY_NEUTRAL_O2 -QTY_VELOCITY_VERTICAL_O2 - -QTY_DENSITY_ION_O2P -QTY_DENSITY_ION_O2DP -QTY_DENSITY_ION_O2PP ---- - -QTY_NITROGEN -QTY_DENSITY_NEUTRAL_N2 -QTY_DENSITY_NEUTRAL_N2D -QTY_DENSITY_NEUTRAL_N2P -QTY_VELOCITY_VERTICAL_N2 - -QTY_DENSITY_ION_N2P ---- - -QTY_O_N2_COLUMN_DENSITY_RATIO ---- - -QTY_DENSITY_ION_NP ---- - -QTY_O3 -QTY_DENSITY_NEUTRAL_O3P -QTY_VELOCITY_VERTICAL_O3P ---- - -QTY_DENSITY_NEUTRAL_N4S -QTY_VELOCITY_VERTICAL_N4S ---- - -QTY_NO -QTY_DENSITY_NEUTRAL_NO -QTY_VELOCITY_VERTICAL_NO - -? QTY_DENSITY_ION_NOP ---- - -QTY_DENSITY_NEUTRAL_H -QTY_ATOMIC_H_MIXING_RATIO - -QTY_DENSITY_ION_HP ---- - -QTY_DENSITY_NEUTRAL_HE - -QTY_DENSITY_ION_HEP ---- - -QTY_GND_GPS_VTEC - -Not needed: -QTY_DENSITY_ION_O4SP -QTY_CO -QTY_DENSITY_NEUTRAL_CO2 -QTY_NO2 -QTY_N2O diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index 3c178c7e02..8444dda153 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -68,9 +68,6 @@ module model_mod private ! routines required by DART code - will be called from filter and other DART executables. -! TODO: Is nc_write_model_vars no longer mandatory? -! Tiegcm has it listed, but it's just a pass-through to-from default_model_mod -! which has a do-nothing version, and a note "currently unused". public :: get_model_size, & get_state_meta_data, & model_interpolate, & @@ -97,7 +94,7 @@ module model_mod !----------------------------------------------------------------------- ! Default values for namelist -character(len=256) :: filter_io_filename = 'filter_input_0001.nc' +character(len=256) :: domain_template_file = 'filter_input_0001.nc' integer :: time_step_days = 0 integer :: time_step_seconds = 3600 integer :: debug = 0 @@ -109,14 +106,14 @@ module model_mod type :: var_type integer :: count character(len=64), allocatable :: names(:) - integer, allocatable :: qtys(:) - real(r8), allocatable :: clamp_values(:, :) - logical, allocatable :: updates(:) + integer, allocatable :: qtys(:) + real(r8), allocatable :: clamp_values(:, :) + logical, allocatable :: updates(:) end type var_type type(var_type) :: var -namelist /model_nml/ filter_io_filename, time_step_days, time_step_seconds, debug, variables +namelist /model_nml/ domain_template_file, time_step_days, time_step_seconds, debug, variables !----------------------------------------------------------------------- ! Dimensions @@ -178,7 +175,7 @@ subroutine static_init_model() call set_calendar_type(calendar) -call assign_dimensions(filter_io_filename) +call assign_dimensions(domain_template_file) ! Dimension start and deltas needed for set_quad_coords lon_start = lons(1) @@ -197,7 +194,7 @@ subroutine static_init_model() ! Define which variables are in the model state ! This is using add_domain_from_file (arg list matches) -dom_id = add_domain(filter_io_filename, var%count, var%names, var%qtys, & +dom_id = add_domain(domain_template_file, var%count, var%names, var%qtys, & var%clamp_values, var%updates) call state_structure_info(dom_id) @@ -462,16 +459,16 @@ end subroutine nc_write_model_atts ! Read dimension information from the template file and use ! it to assign values to variables. -subroutine assign_dimensions(filter_io_filename) +subroutine assign_dimensions(domain_template_file) -character(len=*), intent(in) :: filter_io_filename +character(len=*), intent(in) :: domain_template_file integer :: ncid character(len=24), parameter :: routine = 'assign_dimensions' -call error_handler(E_MSG, routine, 'reading filter input ['//trim(filter_io_filename)//']') +call error_handler(E_MSG, routine, 'reading filter input ['//trim(domain_template_file)//']') -ncid = nc_open_file_readonly(filter_io_filename, routine) +ncid = nc_open_file_readonly(domain_template_file, routine) ! levels nlev = nc_get_dimension_size(ncid, trim(LEV_DIM_NAME), routine) diff --git a/models/aether_lat-lon/model_mod.nml b/models/aether_lat-lon/model_mod.nml index 33142734b0..d7af938fec 100644 --- a/models/aether_lat-lon/model_mod.nml +++ b/models/aether_lat-lon/model_mod.nml @@ -1,32 +1,9 @@ &model_nml - filter_io_filename = 'if other than filter_input_0001.nc' + domain_template_file = 'if other than filter_input_0001.nc' debug = 0 variables = 'Temperature', 'QTY_TEMPERATURE', '1000.0', 'NA', 'UPDATE', 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' time_step_days = 0 time_step_seconds = 3600 / -! Aether ion variable names need transformation for DART into (O+ example): - Opos QTY_DENSITY_ION_OP - Opos_Temperature - Opos_velocity_parallel_east - Opos_velocity_parallel_north - Opos_velocity_parallel_up - Opos_velocity_perp_east - Opos_velocity_perp_north - Opos_velocity_perp_up -! Other variables - velocity_up QTY_VERTICAL_VELOCITY - O2pos QTY_DENSITY_ION_O2P - N2pos QTY_DENSITY_ION_N2P ? - O2pos_2D QTY_DENSITY_ION_O2DP ? - O2pos_2P QTY_DENSITY_ION_O2PP ? - NOpos - Npos - Hepos -! See ./issue_QTYs for complete lists of variables and potential QTYs - -Future?: -x estimate_f10_7 = .false. -x f10_7_file_name = 'f10_7.nc' diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index 694fc75206..090c3a39cd 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -4,12 +4,12 @@ Aether Rectangular Grid Interface Overview -------- -The `Aether` ("eether") space weather model can be implemented +The `Aether`_ ("eether") space weather model can be implemented on a logically rectangular grid "lat-lon", or on an the cubed-sphere grid (see ../aether_cubed_shere). This is the interface to the lat-lon version. -.. Aether: https://aetherdocumentation.readthedocs.io/en/latest/ +.. _Aether: https://aetherdocumentation.readthedocs.io/en/latest/ Aether writes history and restart files, with some overlap of the fields (?). The restart fields are divided among 2 types of files: neutrals and ions. @@ -59,7 +59,9 @@ transform_state_nml nblocks_lon, nblocks_lat, nblocks_lev Number of Aether domain "blocks" in the longitudinal, latitudinal, - and vertical directions. (vertical is always 1 as of 2024-2) + and vertical directions. Vertical is always 1 (2024-2). + The total number of blocks (nblocks_lon x nblocks_lat x nblocks_lev) + is defined by the number of processors used by Aether. variables The Aether fields to be included in the model state are specified @@ -75,7 +77,7 @@ transform_state_nml in ./aether_to_dart.nml. The neutrals restart files contain the following fields. - The most important fields are **highlighted** + The most important fields are **noted in bold text** | **Temperature**, **velocity_east**, **velocity_north**, | velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 @@ -97,15 +99,16 @@ transform_state_nml - velocity_perp_up\ \(O+\) .. WARNING:: - As of this writing (2024-1-30) the electron density is not available - through the restart files, even though electron temperature is. - It can be written to the history files. + As of this writing (2024-1-30) the electron density and solar radiation + parameter "f10.7" are not available through the restart files, + even though electron temperature is. + They may be available in the history files. model_nml ......... -filter_io_filename +domain_template_file = 'if other than filter_input_0001.nc' variables @@ -128,6 +131,37 @@ variables For example 'velocity_parallel_east\\ \\(O+_2D\\)' becomes 'Opos_2D_velocity_parallel_east'. + The DART QTY associated with each variable is an open question, + depending on the forward operators required for the available observations + and on the scientific objective. The default choices are not necessarily correct + for your assimilation. For the fields identified as most important + in early Aether assimilation experiments, these are the defaults:: +============== ==================== +variable quantity (kind) +============== ==================== +Temperature QTY_TEMPERATURE +velocity_east QTY_U_WIND_COMPONENT +velocity_north QTY_V_WIND_COMPONENT +Opos QTY_DENSITY_ION_OP +O2pos QTY_DENSITY_ION_O2P +N2pos QTY_DENSITY_ION_N2P +O2pos_2D QTY_DENSITY_ION_O2DP +O2pos_2P QTY_DENSITY_ION_O2PP +============== ==================== + + Some variables could have one of several QTYs associated with them. + For example, the variable 'Opos_velocity_parallel_up' + could potentially have these existing QTYs associated with it:: + - QTY_VELOCITY_W + - QTY_VELOCITY_W_ION + - QTY_VERTICAL_VELOCITY + It's possible that several variables could have the same QTY. + A third possibility is that the experiment may require the creation of a new QTY. + The example above may require something like QTY_VEL_PARALLEL_VERT_OP. + +.. WARNING:: + The size of these parameters may be limited to 31 characters (``types_mod.f90``) + time_step_days, time_step_seconds = 0, 3600 The hindcast period between assimilations. @@ -141,12 +175,17 @@ To test the transformation of files for member 0: > cd {aether_restart_dirname} > mkdir Orig -> cp *m0000* Orig +> cp *m0000* Orig/ > ./aether_to_dart 0 > cp filter_input_0001.nc filter_output_0001.nc > ./dart_to_aether 0 -| The filter\_ files now contain the CF-compliant field names which must be used in model_nml:variables. +| The filter\_ files will contain the CF-compliant field names which must be used in model_nml:variables. | Compare the modified Aether restart files with those in Orig. -| (Some halo regions may have no data in them because Aether currently (2024-2) does not use those regions.) +.. NOTE: + Some halo parts may have no data in them because Aether currently (2024-2) + does not use those regions. +.. WARNING: + The restart files have dimensions ordered such that common viewing tools + (e.g. ncview) may display the pictures transposed from what is expected. diff --git a/models/aether_lat-lon/transform_state.nml b/models/aether_lat-lon/transform_state.nml index e0f1ae021e..1ac776fc32 100644 --- a/models/aether_lat-lon/transform_state.nml +++ b/models/aether_lat-lon/transform_state.nml @@ -9,22 +9,3 @@ nblocks_lev = 1 debug = 0 / -! Neutrals from restart files, which Aaron identified as important: - Temperature - velocity_east - velocity_north -! Ion densities from restart files, which Aaron identified as important: - O+ - O2+ - O+_2D - O+_2P - N2+ -! Other variables - velocity_up 'neutrals - Velocity components of the ions, e.g. - 'velocity_perp_east\ \(O+\)', 'ions', - 'velocity_perp_north\ \(O+\)', 'ions', - 'velocity_perp_up\ \(O+\)', 'ions', - 'velocity_parallel_east\ \(O+\)', 'ions', - 'velocity_parallel_north\ \(O+\)','ions', - 'velocity_parallel_up\ \(O+\)', 'ions', From 3c7d8ded7ed5aee7241f37bff5a2ce8d76d7fc54 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Thu, 8 Feb 2024 10:30:23 -0700 Subject: [PATCH 101/124] Removed setting of calendar from model_mod Prevent users from mistakenly setting it to Aether's calendar. Fixed quickbuild's MODEL to use the new model name (aether_lat-lon). Removed comments from work/input.nml. No changes to aether_to_dart and dart_to_aether. Passed model_mod_check 1-5,7. --- models/aether_lat-lon/model_mod.f90 | 5 +-- models/aether_lat-lon/work/input.nml | 57 +----------------------- models/aether_lat-lon/work/quickbuild.sh | 2 +- 3 files changed, 3 insertions(+), 61 deletions(-) diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index 8444dda153..ed01bde61f 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -15,7 +15,7 @@ module model_mod r8, i8, MISSING_R8, vtablenamelength use time_manager_mod, only : & - time_type, set_calendar_type, set_time + time_type, set_time use location_mod, only : & location_type, get_close_type, & @@ -148,7 +148,6 @@ module model_mod integer, parameter :: UNKNOWN_OBS_QTY_ERROR_CODE = 20 type(time_type) :: state_time ! module-storage declaration of current model time -character(len=32) :: calendar = 'GREGORIAN' character(len=512) :: error_string_1, error_string_2 contains @@ -173,8 +172,6 @@ subroutine static_init_model() if (do_nml_file()) write(nmlfileunit, nml=model_nml) if (do_nml_term()) write( * , nml=model_nml) -call set_calendar_type(calendar) - call assign_dimensions(domain_template_file) ! Dimension start and deltas needed for set_quad_coords diff --git a/models/aether_lat-lon/work/input.nml b/models/aether_lat-lon/work/input.nml index 64058c2306..e0c01691c7 100644 --- a/models/aether_lat-lon/work/input.nml +++ b/models/aether_lat-lon/work/input.nml @@ -117,15 +117,9 @@ print_every_nth_obs = 0 / -! transform state -! Each variable must have 2 entries. -! 1: Aether variable name from {neutrals,ions}_mMMMM_gBBBB.nc -! 2: which aether netcdf file contains the variable - neutrals or ions -! All neutrals must be listed before the ions. - &transform_state_nml aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lon-lat/testdata3' + '/Users/raeder/DAI/Manhattan/models/aether_lat-lon/testdata3' variables = 'Temperature', 'neutrals', 'O+', 'ions', @@ -134,36 +128,6 @@ nblocks_lev = 1 debug = 0 / -! Neutrals from restart files, which Aaron identified as important: - Temperature - velocity_east - velocity_north -! Ion densities from restart files, which Aaron identified as important: - O+ - O2+ - O+_2D - O+_2P - N2+ -! Other variables - velocity_up 'neutrals - Velocity components of the ions, e.g. - 'velocity_perp_east\ \(O+\)', 'ions', - 'velocity_perp_north\ \(O+\)', 'ions', - 'velocity_perp_up\ \(O+\)', 'ions', - 'velocity_parallel_east\ \(O+\)', 'ions', - 'velocity_parallel_north\ \(O+\)','ions', - 'velocity_parallel_up\ \(O+\)', 'ions', - -! model_mod -! Each variable must have 5 entries. -! 1: CF-compliant variable name found in filter_input_####.nc -! 2: DART KIND (QTY) -! 3: minimum value - as a character string - if none, use 'NA' -! 4: maximum value - as a character string - if none, use 'NA' -! 5: does the updated variable need to be written to the restart files? -! 'UPDATE' => updated variable written to file -! 'anything else' => variable not written to file -! all these variables will be updated INTERNALLY IN DART. &model_nml filter_io_filename = 'filter_input_0001.nc' @@ -174,25 +138,6 @@ time_step_seconds = 3600 debug = 10 / -! Aether ion variable names need transformation for DART into (O+ example): - Opos QTY_DENSITY_ION_OP - Opos_Temperature - Opos_velocity_parallel_east - Opos_velocity_parallel_north - Opos_velocity_parallel_up - Opos_velocity_perp_east - Opos_velocity_perp_north - Opos_velocity_perp_up -! Other variables - velocity_up QTY_VERTICAL_VELOCITY - O2pos QTY_DENSITY_ION_O2P - N2pos QTY_DENSITY_ION_N2P ? - O2pos_2D QTY_DENSITY_ION_O2DP ? - O2pos_2P QTY_DENSITY_ION_O2PP ? - NOpos - Npos - Hepos -! See ./issue_QTYs for complete lists of variables and potential QTYs &cov_cutoff_nml select_localization = 1 diff --git a/models/aether_lat-lon/work/quickbuild.sh b/models/aether_lat-lon/work/quickbuild.sh index 722632c04f..c66e533a93 100755 --- a/models/aether_lat-lon/work/quickbuild.sh +++ b/models/aether_lat-lon/work/quickbuild.sh @@ -9,7 +9,7 @@ main() { export DART=$(git rev-parse --show-toplevel) source "$DART"/build_templates/buildfunctions.sh -MODEL=aether_lon-lat +MODEL=aether_lat-lon LOCATION=threed_sphere programs=( From d7c6bdd7e2589efc12ddee528e1783b496872402 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 13 Feb 2024 09:40:16 -0700 Subject: [PATCH 102/124] Addressed most suggestions in first 2 batches of reviews, for the transform code --- models/aether_lat-lon/aether_to_dart.f90 | 9 +++++- models/aether_lat-lon/dart_to_aether.f90 | 17 ++++++---- models/aether_lat-lon/readme.rst | 41 ++++++++++++++++-------- models/aether_lat-lon/work/quickbuild.sh | 1 - 4 files changed, 47 insertions(+), 21 deletions(-) diff --git a/models/aether_lat-lon/aether_to_dart.f90 b/models/aether_lat-lon/aether_to_dart.f90 index 365f72e8a9..2207ac88ec 100644 --- a/models/aether_lat-lon/aether_to_dart.f90 +++ b/models/aether_lat-lon/aether_to_dart.f90 @@ -28,7 +28,14 @@ program aether_to_dart use default_model_mod, only : write_model_time -use transform_state_mod +use transform_state_mod, only : & + static_init_blocks, aether_name_to_dart, & + nghost, open_block_file, aether_restart_dirname, & + VT_ORIGININDX, VT_VARNAMEINDX, nvar_neutral, nvar_ion, & + nx_per_block, ny_per_block, nz_per_block, & + nblocks_lon, nblocks_lat, variables, & + lats, levs, lons, debug, state_time, & + block_file_name, nlat, nlon, nlev, purge_chars use netcdf_utilities_mod, only : & nc_create_file, nc_close_file, & diff --git a/models/aether_lat-lon/dart_to_aether.f90 b/models/aether_lat-lon/dart_to_aether.f90 index 2148f3caff..c68cdfd3f5 100644 --- a/models/aether_lat-lon/dart_to_aether.f90 +++ b/models/aether_lat-lon/dart_to_aether.f90 @@ -24,7 +24,13 @@ program dart_to_aether use default_model_mod, only : write_model_time -use transform_state_mod +use transform_state_mod, only : & + debug, aether_restart_dirname, nblocks_lat, & + nblocks_lon, nghost, nlat, nlon, nlev, & + nx_per_block, ny_per_block, nz_per_block, & + nvar_ion, nvar_neutral, VT_ORIGININDX, VT_VARNAMEINDX, & + block_file_name, open_block_file, aether_name_to_dart, & + variables, purge_chars, static_init_blocks use netcdf_utilities_mod, only : & nc_open_file_readonly, nc_close_file, & @@ -49,7 +55,7 @@ program dart_to_aether character(len=64) :: filter_io_file = '' character(len=512) :: error_string_1, error_string_2 character(len=31), parameter :: progname = 'dart_to_aether' -character(len=256), parameter :: source = 'aether_lat-lon/dart_to_aether..f90' +character(len=256), parameter :: source = 'aether_lat-lon/dart_to_aether.f90' !====================================================================== @@ -108,7 +114,7 @@ subroutine filter_to_restarts(ncid, member) integer, intent(in) :: member, ncid -real(r4), allocatable :: fulldom1d(:), fulldom3d(:,:,:) +real(r4), allocatable :: fulldom3d(:,:,:) character(len=256) :: file_root integer :: ivar character(len=vtablenamelength) :: varname, dart_varname @@ -188,7 +194,6 @@ subroutine filter_to_restarts(ncid, member) enddo deallocate(fulldom3d) -!, fulldom1d end subroutine filter_to_restarts @@ -265,8 +270,8 @@ subroutine add_halo_fulldom3d(fulldom3d) ! For O+ range from 0 to 7e+11, but are close to 1.1082e+10 near the corners. ! 2023-12-20; Aaron sent new files with 54 levels. if (debug >= 100 .and. do_output()) then - if (fulldom3d(54,10,10) > 1.e+10) then - normed = fulldom3d(54,:,:) - 1.1092e+10 + if (fulldom3d(54,10,10) > 1.e+10_r4) then + normed = fulldom3d(54,:,:) - 1.1092e+10_r4 debug_format = '(3(4E10.4,2X))' else if (fulldom3d(54,10,10) < 1000._r4) then normed = fulldom3d(54,:,:) - 800._r4 diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index 18cbc20794..e6993d1e74 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -6,12 +6,12 @@ Overview The `Aether`_ ("eether") space weather model can be implemented on a logically rectangular grid "lat-lon", -or on an the cubed-sphere grid (see ../aether_cubed_shere). +or on an the cubed-sphere grid. This is the interface to the lat-lon version. .. _Aether: https://aetherdocumentation.readthedocs.io/en/latest/ -Aether writes history and restart files, with some overlap of the fields (?). +Aether writes history and restart files, with some overlap of the fields. The restart fields are divided among 2 types of files: neutrals and ions. They are further divided into "blocks", which are subdomains of the globe. Blocks start in the southwest corner of the lat/lon grid and go east first, @@ -19,20 +19,21 @@ then to the west end of the next row north and end in the northeast corner. Each block has a halo around it filled with field values from neighboring blocks. All of these need to be combined to make a single state vector for filter. There's a unique set of these files for each member. -The restart file names reflect this information: +The restart file names reflect this information :: -| {neutrals,ions}_mMMMM_gBBBB.nc -| MMMM = ensemble member (0-based) -| BBBB = block number (0-based) + | {neutrals,ions}_mMMMM_gBBBB.nc + | MMMM = ensemble member (0-based) + | BBBB = block number (0-based) -The restart files do not have grid information in them, which must be read from +The restart files do not have grid information in them. +Grid information must be read from grid_gBBBB.nc Aether_to_dart and dart_to_aether read the same namelist; transform_state_nml. The fields chosen to be part of the model state are specified in ``variables``. Program aether_to_dart will read the specified fields, from all the restarts for a member plus grid files, and repackage them into an ensemble state vector file -(filter_input.nc), which has a single domain and no halos. +(filter_input.nc). Filter_input.nc has a single domain and no halos. The field names will be transformed into CF-compliant names in filter_input.nc. Filter will read the ensemble of filter_input.nc files, assimilate, @@ -72,9 +73,21 @@ transform_state_nml 2) which file contains the field ("neutrals" or "ions") Aether field names are not CF-compliant and are translated - to CF-compliant forms by aether_to_dart. - The suggested DART quantity to associate with some fields are listed - in ./aether_to_dart.nml. + to CF-compliant forms by aether_to_dart. + +.. TIP:: + If you have a set of files with older Aether variable names and want to convert + them to newer, still-non-compliant names, you may be able to use (or modify) + ``./matlab/new_varname_file.m``. As of 2024-2 the following + could not handle the non-compliant names:: + - NetCDF fortran interface, + - NCO's ``ncrename``, + - Matlab's ``netcdf.rename`` + + There is no association of DART "quantities" (QTY\_*) with variables in + ``transform_state_nml``. Those associations are made in ``model_nml`` for use by ``filter``. + See the :ref:`QTY` section, below. + The neutrals restart files contain the following fields. The most important fields are **noted in bold text** @@ -131,6 +144,8 @@ variables For example 'velocity_parallel_east\\ \\(O+_2D\\)' becomes 'Opos_2D_velocity_parallel_east'. +.. _QTY: + The DART QTY associated with each variable is an open question, depending on the forward operators required for the available observations and on the scientific objective. The default choices are not necessarily correct @@ -182,10 +197,10 @@ To test the transformation of files for member 0: | The filter\_ files will contain the CF-compliant field names which must be used in model_nml:variables. | Compare the modified Aether restart files with those in Orig. -.. NOTE: +.. NOTE:: Some halo parts may have no data in them because Aether currently (2024-2) does not use those regions. -.. WARNING: +.. WARNING:: The restart files have dimensions ordered such that common viewing tools (e.g. ncview) may display the pictures transposed from what is expected. diff --git a/models/aether_lat-lon/work/quickbuild.sh b/models/aether_lat-lon/work/quickbuild.sh index c66e533a93..dd1b063219 100755 --- a/models/aether_lat-lon/work/quickbuild.sh +++ b/models/aether_lat-lon/work/quickbuild.sh @@ -28,7 +28,6 @@ obs_seq_to_netcdf model_serial_programs=( aether_to_dart dart_to_aether) -# transform_names arguments "$@" From a91f706819d1bddb7ba7eb46d07f8c47216f6777 Mon Sep 17 00:00:00 2001 From: Helen Kershaw <20047007+hkershaw-brown@users.noreply.github.com> Date: Tue, 13 Feb 2024 13:10:11 -0500 Subject: [PATCH 103/124] direct people to Aether --- models/aether_lat-lon/readme.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index 18cbc20794..f99f97fdd2 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -9,7 +9,7 @@ on a logically rectangular grid "lat-lon", or on an the cubed-sphere grid (see ../aether_cubed_shere). This is the interface to the lat-lon version. -.. _Aether: https://aetherdocumentation.readthedocs.io/en/latest/ +Aether is available on GitHub https://github.com/AetherModel/Aether Aether writes history and restart files, with some overlap of the fields (?). The restart fields are divided among 2 types of files: neutrals and ions. From 9751081259d9e2df8099202e12dc930f5917df59 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 13 Feb 2024 12:58:19 -0700 Subject: [PATCH 104/124] Better formatting and more consistent notation in readme --- models/aether_lat-lon/readme.rst | 84 +++++++++++++++++--------------- 1 file changed, 45 insertions(+), 39 deletions(-) diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index e6993d1e74..adddd7464f 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -21,25 +21,27 @@ All of these need to be combined to make a single state vector for filter. There's a unique set of these files for each member. The restart file names reflect this information :: - | {neutrals,ions}_mMMMM_gBBBB.nc - | MMMM = ensemble member (0-based) - | BBBB = block number (0-based) + {neutrals,ions}_mMMMM_gBBBB.nc + MMMM = ensemble member (0-based) + BBBB = block number (0-based) The restart files do not have grid information in them. -Grid information must be read from - grid_gBBBB.nc +Grid information must be read from :: -Aether_to_dart and dart_to_aether read the same namelist; transform_state_nml. -The fields chosen to be part of the model state are specified in ``variables``. -Program aether_to_dart will read the specified fields, from all the restarts + grid_gBBBB.nc + +Programs ``aether_to_dart`` and ``dart_to_aether`` read the same namelist; +``transform_state_nml``. +The fields chosen to be part of the model state are specified in 'variables'. +``Aether_to_dart`` will read the specified fields, from all the restarts for a member plus grid files, and repackage them into an ensemble state vector file (filter_input.nc). Filter_input.nc has a single domain and no halos. The field names will be transformed into CF-compliant names in filter_input.nc. -Filter will read the ensemble of filter_input.nc files, assimilate, +``Filter`` will read the ensemble of filter_input.nc files, assimilate, and write an ensemble of filter_output.nc files. -Dart_to_aether will convert the fields' names to the CF-compliant filter names, +``Dart_to_aether`` will convert the fields' names to the CF-compliant filter names, find those names in filter_output.nc, extract the updated field data, and overwrite those fields in the appropriate Aether restart files. @@ -66,7 +68,7 @@ transform_state_nml variables The Aether fields to be included in the model state are specified - in the ``variables`` namelist variable in transform_state_nml. + in the 'variables' namelist variable in transform_state_nml. The following information must be provided for each field 1) Aether field name @@ -75,30 +77,30 @@ transform_state_nml Aether field names are not CF-compliant and are translated to CF-compliant forms by aether_to_dart. -.. TIP:: - If you have a set of files with older Aether variable names and want to convert - them to newer, still-non-compliant names, you may be able to use (or modify) - ``./matlab/new_varname_file.m``. As of 2024-2 the following - could not handle the non-compliant names:: - - NetCDF fortran interface, - - NCO's ``ncrename``, - - Matlab's ``netcdf.rename`` - - There is no association of DART "quantities" (QTY\_*) with variables in - ``transform_state_nml``. Those associations are made in ``model_nml`` for use by ``filter``. - See the :ref:`QTY` section, below. - + TIP: + If you have a set of files with older Aether field names and want to convert + them to newer, still-non-compliant names, you may be able to use (or modify) + ``./matlab/new_varname_file.m``. As of 2024-2 the following + could not handle the non-compliant names:: + + - NetCDF fortran interface, + - NCO's ``ncrename``, + - Matlab's ``netcdf.rename`` + + In ``transform_state_nml`` there is no association of DART "quantities" + (QTY\_\*) with fields. Those associations are made in ``model_nml`` + for use by ``filter``. See the :ref:`QTY` section, below. The neutrals restart files contain the following fields. The most important fields are **noted in bold text** - | **Temperature**, **velocity_east**, **velocity_north**, - | velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 + | **Temperature**, **velocity_east**, **velocity_north**, + | velocity_up, N, O2, N2, NO, He, N_2D, N_2P, H, O_1D, CO2 Similarly for the ions restart files - | **O+**, **O+_2D**, **O+_2P**, **O2+**, **N2+**, NO+, N+, He+, - | Temperature_bulk_ion, Temperature_electron + | **O+**, **O+_2D**, **O+_2P**, **O2+**, **N2+**, NO+, N+, He+, + | Temperature_bulk_ion, Temperature_electron In addition, there are 7 (independent) fields associated with *each* ion density :: @@ -122,7 +124,7 @@ model_nml ......... template_file - = 'if other than filter_input_0001.nc' + = 'filter_input_0001.nc' is the default variables Each field to be included in the state vector requires 5 descriptors: @@ -133,7 +135,7 @@ variables #) max value #) update the field in the restart file? {UPDATE,NO_COPY_BACK} - The field names listed in ``variables`` must be the *transformed* names, + The field names listed in 'variables' must be the *transformed* names, as found in the filter_input.nc files (see :ref:`Usage`). In general the transformation does the following @@ -146,13 +148,14 @@ variables .. _QTY: - The DART QTY associated with each variable is an open question, + The DART QTY associated with each field is an open question, depending on the forward operators required for the available observations and on the scientific objective. The default choices are not necessarily correct for your assimilation. For the fields identified as most important - in early Aether assimilation experiments, these are the defaults:: + in early Aether assimilation experiments, these are the defaults: + ============== ==================== -variable quantity (kind) +variables quantity (kind) ============== ==================== Temperature QTY_TEMPERATURE velocity_east QTY_U_WIND_COMPONENT @@ -164,13 +167,15 @@ O2pos_2D QTY_DENSITY_ION_O2DP O2pos_2P QTY_DENSITY_ION_O2PP ============== ==================== - Some variables could have one of several QTYs associated with them. - For example, the variable 'Opos_velocity_parallel_up' + Some fields could have one of several QTYs associated with them. + For example, the field 'Opos_velocity_parallel_up' could potentially have these existing QTYs associated with it:: - - QTY_VELOCITY_W - - QTY_VELOCITY_W_ION - - QTY_VERTICAL_VELOCITY - It's possible that several variables could have the same QTY. + + - QTY_VELOCITY_W + - QTY_VELOCITY_W_ION + - QTY_VERTICAL_VELOCITY + + It's possible that several fields could have the same QTY. A third possibility is that the experiment may require the creation of a new QTY. The example above may require something like QTY_VEL_PARALLEL_VERT_OP. @@ -197,6 +202,7 @@ To test the transformation of files for member 0: | The filter\_ files will contain the CF-compliant field names which must be used in model_nml:variables. | Compare the modified Aether restart files with those in Orig. + .. NOTE:: Some halo parts may have no data in them because Aether currently (2024-2) does not use those regions. From 7dd64acc8476e20f849482f2bc83dbb694aec050 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Tue, 13 Feb 2024 20:33:32 -0700 Subject: [PATCH 105/124] Move declaration of var from aether module to static_init_model subroutine --- models/aether_lat-lon/model_mod.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index 25c6270131..0fd97ef85e 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -109,8 +109,6 @@ module model_mod logical, allocatable :: updates(:) end type var_type -type(var_type) :: var - namelist /model_nml/ template_file, time_step_days, time_step_seconds, variables !----------------------------------------------------------------------- @@ -159,6 +157,7 @@ module model_mod subroutine static_init_model() integer :: iunit, io +type(var_type) :: var module_initialized = .true. From 4d86643af258f2602243ac9d62a5a1fc93d71b95 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Tue, 13 Feb 2024 20:35:21 -0700 Subject: [PATCH 106/124] Remove comment referencing routine = 'get_state_meta_data' --- models/aether_lat-lon/model_mod.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index 0fd97ef85e..4f63f38636 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -324,7 +324,6 @@ subroutine get_state_meta_data(index_in, location, qty) integer :: lat_index, lon_index, lev_index integer :: my_var_id, my_qty -! character(len=*), parameter :: routine = 'get_state_meta_data' if ( .not. module_initialized ) call static_init_model From 561143d8d46e6049340a84c102f9eec7206d7980 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Tue, 13 Feb 2024 20:36:31 -0700 Subject: [PATCH 107/124] Remove apostrophe from comment to fix syntax highlighting --- models/aether_lat-lon/model_mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index 4f63f38636..29e706b855 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -408,7 +408,7 @@ subroutine assign_dimensions() end subroutine assign_dimensions !----------------------------------------------------------------------- -! Parse the table of variables' characteristics into arrays for easier access. +! Parse the table of variables characteristics into arrays for easier access. function assign_var(variables, MAX_STATE_VARIABLES) result(var) From 1f05e05c661e2056a13afd3814543228a184bec1 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Tue, 13 Feb 2024 20:42:42 -0700 Subject: [PATCH 108/124] Adjust indentation in assign_var function to match convention of three spaces per indent --- models/aether_lat-lon/model_mod.f90 | 104 ++++++++++++++-------------- 1 file changed, 52 insertions(+), 52 deletions(-) diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index 29e706b855..7a7ea3be08 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -412,58 +412,58 @@ end subroutine assign_dimensions function assign_var(variables, MAX_STATE_VARIABLES) result(var) - character(len=vtablenamelength), intent(in) :: variables(:, :) - integer, intent(in) :: MAX_STATE_VARIABLES - - type(var_type) :: var - - integer :: ivar - - !----------------------------------------------------------------------- - ! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table - integer, parameter :: NAME_INDEX = 1 ! ... variable name - integer, parameter :: QTY_INDEX = 2 ! ... DART kind - integer, parameter :: MIN_VAL_INDEX = 3 ! ... minimum value if any - integer, parameter :: MAX_VAL_INDEX = 4 ! ... maximum value if any - integer, parameter :: UPDATE_INDEX = 5 ! ... update (state) or not - - ! Loop through the variables array to get the actual count of the number of variables - do ivar = 1, MAX_STATE_VARIABLES - ! If the element is an empty string, the loop has exceeded the extent of the variables - if (variables(1, ivar) == '') then - var%count = ivar-1 - exit - endif - enddo - - ! Allocate the arrays in the var derived type - allocate(var%names(var%count), var%qtys(var%count), var%clamp_values(var%count, 2), var%updates(var%count)) - - do ivar = 1, var%count - - var%names(ivar) = trim(variables(NAME_INDEX, ivar)) - - var%qtys(ivar) = get_index_for_quantity(variables(QTY_INDEX, ivar)) - - if (variables(MIN_VAL_INDEX, ivar) /= 'NA') then - read(variables(MIN_VAL_INDEX, ivar), '(d16.8)') var%clamp_values(ivar,1) - else - var%clamp_values(ivar,1) = MISSING_R8 - endif - - if (variables(MAX_VAL_INDEX, ivar) /= 'NA') then - read(variables(MAX_VAL_INDEX, ivar), '(d16.8)') var%clamp_values(ivar,2) - else - var%clamp_values(ivar,2) = MISSING_R8 - endif - - if (variables(UPDATE_INDEX, ivar) == 'UPDATE') then - var%updates(ivar) = .true. - else - var%updates(ivar) = .false. - endif - - enddo +character(len=vtablenamelength), intent(in) :: variables(:, :) +integer, intent(in) :: MAX_STATE_VARIABLES + +type(var_type) :: var + +integer :: ivar + +!----------------------------------------------------------------------- +! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table +integer, parameter :: NAME_INDEX = 1 ! ... variable name +integer, parameter :: QTY_INDEX = 2 ! ... DART kind +integer, parameter :: MIN_VAL_INDEX = 3 ! ... minimum value if any +integer, parameter :: MAX_VAL_INDEX = 4 ! ... maximum value if any +integer, parameter :: UPDATE_INDEX = 5 ! ... update (state) or not + +! Loop through the variables array to get the actual count of the number of variables +do ivar = 1, MAX_STATE_VARIABLES + ! If the element is an empty string, the loop has exceeded the extent of the variables + if (variables(1, ivar) == '') then + var%count = ivar-1 + exit + endif +enddo + +! Allocate the arrays in the var derived type +allocate(var%names(var%count), var%qtys(var%count), var%clamp_values(var%count, 2), var%updates(var%count)) + +do ivar = 1, var%count + + var%names(ivar) = trim(variables(NAME_INDEX, ivar)) + + var%qtys(ivar) = get_index_for_quantity(variables(QTY_INDEX, ivar)) + + if (variables(MIN_VAL_INDEX, ivar) /= 'NA') then + read(variables(MIN_VAL_INDEX, ivar), '(d16.8)') var%clamp_values(ivar,1) + else + var%clamp_values(ivar,1) = MISSING_R8 + endif + + if (variables(MAX_VAL_INDEX, ivar) /= 'NA') then + read(variables(MAX_VAL_INDEX, ivar), '(d16.8)') var%clamp_values(ivar,2) + else + var%clamp_values(ivar,2) = MISSING_R8 + endif + + if (variables(UPDATE_INDEX, ivar) == 'UPDATE') then + var%updates(ivar) = .true. + else + var%updates(ivar) = .false. + endif + +enddo end function assign_var From 651d7daeec54227af2410bf00541400c338fe285 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Tue, 13 Feb 2024 20:43:36 -0700 Subject: [PATCH 109/124] Change kind to qty in comment --- models/aether_lat-lon/model_mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index 7a7ea3be08..b05cdaf64a 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -422,7 +422,7 @@ function assign_var(variables, MAX_STATE_VARIABLES) result(var) !----------------------------------------------------------------------- ! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table integer, parameter :: NAME_INDEX = 1 ! ... variable name -integer, parameter :: QTY_INDEX = 2 ! ... DART kind +integer, parameter :: QTY_INDEX = 2 ! ... DART qty integer, parameter :: MIN_VAL_INDEX = 3 ! ... minimum value if any integer, parameter :: MAX_VAL_INDEX = 4 ! ... maximum value if any integer, parameter :: UPDATE_INDEX = 5 ! ... update (state) or not From e3994485dfc794a10b4faca67a0dd47fb4a6a872 Mon Sep 17 00:00:00 2001 From: Ben Johnson Date: Wed, 14 Feb 2024 08:26:58 -0700 Subject: [PATCH 110/124] Improve error avoidance in assign_var function by ensuring DART qty and update_or_nocopyback are uppercase --- models/aether_lat-lon/model_mod.f90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index b05cdaf64a..9db002bc3b 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -416,8 +416,8 @@ function assign_var(variables, MAX_STATE_VARIABLES) result(var) integer, intent(in) :: MAX_STATE_VARIABLES type(var_type) :: var - integer :: ivar +character(len=vtablenamelength) :: table_entry !----------------------------------------------------------------------- ! Codes for interpreting the NUM_STATE_TABLE_COLUMNS of the variables table @@ -443,7 +443,10 @@ function assign_var(variables, MAX_STATE_VARIABLES) result(var) var%names(ivar) = trim(variables(NAME_INDEX, ivar)) - var%qtys(ivar) = get_index_for_quantity(variables(QTY_INDEX, ivar)) + table_entry = variables(QTY_INDEX, ivar) + call to_upper(table_entry) + + var%qtys(ivar) = get_index_for_quantity(table_entry) if (variables(MIN_VAL_INDEX, ivar) /= 'NA') then read(variables(MIN_VAL_INDEX, ivar), '(d16.8)') var%clamp_values(ivar,1) @@ -457,7 +460,10 @@ function assign_var(variables, MAX_STATE_VARIABLES) result(var) var%clamp_values(ivar,2) = MISSING_R8 endif - if (variables(UPDATE_INDEX, ivar) == 'UPDATE') then + table_entry = variables(UPDATE_INDEX, ivar) + call to_upper(table_entry) + + if (table_entry == 'UPDATE') then var%updates(ivar) = .true. else var%updates(ivar) = .false. From 52dfdc48911d3c9f7f35a382490b55862eb1f88f Mon Sep 17 00:00:00 2001 From: kdraeder Date: Wed, 14 Feb 2024 11:47:22 -0700 Subject: [PATCH 111/124] Updated links to Aether info --- models/aether_lat-lon/readme.rst | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index ef63887788..8da7695e68 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -4,18 +4,20 @@ Aether Rectangular Grid Interface Overview -------- -The `Aether`_ ("eether") space weather model can be implemented -on a logically rectangular grid "lat-lon", -or on an the cubed-sphere grid. +The Aether ("eether") space weather model can be implemented +on a logically rectangular grid "lat-lon", or on an the cubed-sphere grid. This is the interface to the lat-lon version. +The model code is available on +`GitHub `_ . +Additional documentation can be found +`here `_ . -Aether is available on GitHub https://github.com/AetherModel/Aether - -Aether writes history and restart files, with some overlap of the fields. +Aether writes history and restart files. The restart fields are divided among 2 types of files: neutrals and ions. They are further divided into "blocks", which are subdomains of the globe. -Blocks start in the southwest corner of the lat/lon grid and go east first, -then to the west end of the next row north and end in the northeast corner. +The numbering of blocks starts in the southwest corner of the lat-lon grid +and goes east first, then to the west end of the next row north, +and ends in the northeast corner. Each block has a halo around it filled with field values from neighboring blocks. All of these need to be combined to make a single state vector for filter. There's a unique set of these files for each member. From bbf7b25321b0d7895407d0aae0d2a8f9834c48fd Mon Sep 17 00:00:00 2001 From: Ben Johnson <6147831+johnsonbk@users.noreply.github.com> Date: Wed, 14 Feb 2024 12:47:43 -0700 Subject: [PATCH 112/124] Update input.nml to remove debug entry in quad_interpolate_nml Co-authored-by: Helen Kershaw <20047007+hkershaw-brown@users.noreply.github.com> --- models/aether_lat-lon/work/input.nml | 1 - 1 file changed, 1 deletion(-) diff --git a/models/aether_lat-lon/work/input.nml b/models/aether_lat-lon/work/input.nml index 40001f6616..3630d4774d 100644 --- a/models/aether_lat-lon/work/input.nml +++ b/models/aether_lat-lon/work/input.nml @@ -322,5 +322,4 @@ / &quad_interpolate_nml - debug = 999 / From 7ab33e3d89fd782bd9a662a497b54d4d29f0298e Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Wed, 14 Feb 2024 13:05:21 -0700 Subject: [PATCH 113/124] set Gregorian calendar fixes: https://github.com/NCAR/DART/pull/635#issuecomment-1944504014 --- models/aether_lat-lon/model_mod.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/models/aether_lat-lon/model_mod.f90 b/models/aether_lat-lon/model_mod.f90 index 9db002bc3b..87ac6c0e9c 100644 --- a/models/aether_lat-lon/model_mod.f90 +++ b/models/aether_lat-lon/model_mod.f90 @@ -15,7 +15,7 @@ module model_mod r8, i8, MISSING_R8, vtablenamelength use time_manager_mod, only : & - time_type, set_time + time_type, set_time, set_calendar_type use location_mod, only : & location_type, get_close_type, & @@ -165,6 +165,8 @@ subroutine static_init_model() read(iunit, nml = model_nml, iostat = io) call check_namelist_read(iunit, io, "model_nml") +call set_calendar_type('GREGORIAN') + ! 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) From e9001e28ae2981257afaa6a8441af80123fe7277 Mon Sep 17 00:00:00 2001 From: Moha El Gharamti Date: Tue, 20 Feb 2024 09:36:22 -0700 Subject: [PATCH 114/124] Changes after cycling DA testing Suggested changes to the compressed code after testing for the Arabian Gulf. The code has been reported to work fine for several DA cycles. A small bug was fixed when parsing the vertical layers for the pickup files. --- models/MITgcm_ocean/trans_mitdart_mod.f90 | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/models/MITgcm_ocean/trans_mitdart_mod.f90 b/models/MITgcm_ocean/trans_mitdart_mod.f90 index b9302a4692..8ce45307df 100644 --- a/models/MITgcm_ocean/trans_mitdart_mod.f90 +++ b/models/MITgcm_ocean/trans_mitdart_mod.f90 @@ -521,6 +521,7 @@ end subroutine mit2dart subroutine dart2mit() integer :: ncid +recl2d = Nx*Ny*8 if (.not. module_initialized) call static_init_trans @@ -559,6 +560,10 @@ subroutine dart2mit() endif !Fill the data +iunit = get_unit() +open(iunit, file='PICKUP.OUTPUT', form="UNFORMATTED", status='UNKNOWN', & + access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') + call from_netcdf_to_mit_3d_pickup(ncid, 'UVEL', 1, MITgcm_3D_FIELD_U) call from_netcdf_to_mit_3d_pickup(ncid, 'VVEL', 2, MITgcm_3D_FIELD_V) call from_netcdf_to_mit_3d_pickup(ncid, 'PTMP', 3, MITgcm_3D_FIELD) @@ -929,6 +934,8 @@ subroutine from_netcdf_to_mit_2d_pickup(ncid, name) integer :: varid real(r4) :: local_fval + + call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) @@ -944,13 +951,11 @@ subroutine from_netcdf_to_mit_2d_pickup(ncid, name) where (var == local_fval) var = binary_fill var8 = var -iunit = get_unit() -open(iunit, file='PICKUP.OUTPUT', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') + if (do_bgc) then write(iunit,rec=401) var8 else - write(iunit,rec=351) var8 + write(iunit,rec=481) var8 endif close(iunit) @@ -968,7 +973,8 @@ subroutine from_netcdf_to_mit_3d_pickup(ncid, name, lev, field) integer :: varid, i real(r4) :: local_fval integer :: LB, RB, RF - + + call check( NF90_INQ_VARID(ncid,name,varid) ) call check( nf90_get_att(ncid,varid,"_FillValue",local_fval)) @@ -984,12 +990,10 @@ subroutine from_netcdf_to_mit_3d_pickup(ncid, name, lev, field) where (var == local_fval) var = binary_fill var8 = var -iunit = get_unit() -open(iunit, file='PICKUP.OUTPUT', form="UNFORMATTED", status='UNKNOWN', & - access='DIRECT', recl=recl2d, convert='BIG_ENDIAN') + LB = Nz * (lev-1) + 1 -RB = Nx * lev +RB = Nz * lev RF = Nz * (lev-1) do i = LB, RB write(iunit,rec=i) var8(:, :, i - RF) From b9520e5659471b878167d0e88c04b60face8f202 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sat, 9 Mar 2024 13:31:46 -0700 Subject: [PATCH 115/124] Enabled running *_to_* outside of the restart directory Added aether_restart_dirname to all filenames that are opened. Removed aether_restart_dirname (and local names) from argument lists because it's a global variable. Updated readme.rst with better instructions for testing *_to_* and clarifications. Made the default aether_restart_dirname = '.' so that it can be left out of the namelist when running the executables in a run directory where the restart files are. Passed file conversion tests and model_mod_check tests 1-5,7. --- models/aether_lat-lon/aether_to_dart.f90 | 20 ++++----- models/aether_lat-lon/dart_to_aether.f90 | 16 ++++--- models/aether_lat-lon/readme.rst | 44 +++++++++++++++---- models/aether_lat-lon/transform_state.nml | 2 +- models/aether_lat-lon/transform_state_mod.f90 | 20 ++++----- models/aether_lat-lon/work/input.nml | 2 +- 6 files changed, 66 insertions(+), 38 deletions(-) diff --git a/models/aether_lat-lon/aether_to_dart.f90 b/models/aether_lat-lon/aether_to_dart.f90 index 2207ac88ec..7d69c089e4 100644 --- a/models/aether_lat-lon/aether_to_dart.f90 +++ b/models/aether_lat-lon/aether_to_dart.f90 @@ -104,7 +104,7 @@ program aether_to_dart call error_handler(E_MSG, '', '') ! nc_create_file does not leave define mode. -ncid = nc_create_file(filter_io_file) +ncid = nc_create_file(trim(aether_restart_dirname)//'/'//trim(filter_io_file)) ! def_fill_dimvars does leave define mode. call def_fill_dimvars(ncid) @@ -113,10 +113,10 @@ program aether_to_dart call write_model_time(ncid, state_time) ! Define (non-time) variables -call restarts_to_filter(aether_restart_dirname, ncid, member, define=.true.) +call restarts_to_filter(ncid, member, define=.true.) ! Read and convert (non-time) variables -call restarts_to_filter(aether_restart_dirname, ncid, member, define=.false.) +call restarts_to_filter(ncid, member, define=.false.) ! subr. called by this routine closes the file only if define = .true. call nc_close_file(ncid) @@ -139,9 +139,8 @@ program aether_to_dart ! .true. define variables in the file or ! .false. transfer the data from restart files to a filter_inpu.nc file. -subroutine restarts_to_filter(dirname, ncid_output, member, define) +subroutine restarts_to_filter(ncid_output, member, define) -character(len=*), intent(in) :: dirname integer, intent(in) :: ncid_output, member logical, intent(in) :: define @@ -163,7 +162,7 @@ subroutine restarts_to_filter(dirname, ncid_output, member, define) do jb = 1, jb_loop do ib = 1, ib_loop - call block_to_filter_io(ncid_output, dirname, ib, jb, member, define) + call block_to_filter_io(ncid_output, ib, jb, member, define) enddo enddo @@ -179,10 +178,9 @@ end subroutine restarts_to_filter ! define = .true. define the NC variables in the filter_input.nc ! define = .false. write the data from a block to the NC file using write_filter_io. -subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) +subroutine block_to_filter_io(ncid_output, ib, jb, member, define) integer, intent(in) :: ncid_output -character(len=*), intent(in) :: dirname integer, intent(in) :: ib, jb integer, intent(in) :: member logical, intent(in) :: define @@ -264,7 +262,8 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) ! Each field has a file type associated with it: variables(VT_ORIGININDX,f_index) file_root = variables(VT_ORIGININDX,1) -filename = block_file_name(file_root, member, nb) +write(filename,'(A,"/",A)') trim(aether_restart_dirname), & + trim(block_file_name(trim(file_root), member, nb)) ncid_input = open_block_file(filename, 'read') do ivar = 1, nvar_neutral @@ -304,7 +303,8 @@ subroutine block_to_filter_io(ncid_output, dirname, ib, jb, member, define) call nc_close_file(ncid_input) file_root = variables(VT_ORIGININDX,nvar_neutral+1) -filename = block_file_name(file_root, member, nb) +write(filename,'(A,"/",A)') trim(aether_restart_dirname), & + trim(block_file_name(trim(file_root), member, nb)) ncid_input = open_block_file(filename, 'read') do ivar = nvar_neutral +1, nvar_neutral + nvar_ion diff --git a/models/aether_lat-lon/dart_to_aether.f90 b/models/aether_lat-lon/dart_to_aether.f90 index c68cdfd3f5..9022167117 100644 --- a/models/aether_lat-lon/dart_to_aether.f90 +++ b/models/aether_lat-lon/dart_to_aether.f90 @@ -83,11 +83,12 @@ program dart_to_aether call error_handler(E_MSG, source, '', '') write(error_string_1,'(3A)') 'Extracting fields from DART file ',trim(filter_io_file) -write(error_string_2,'(A,I3,2A)') 'into Aether restart member ',member,' in directory ', trim(aether_restart_dirname) +write(error_string_2,'(A,I3,2A)') 'into Aether restart member ',member, & + ' in directory ', trim(aether_restart_dirname) call error_handler(E_MSG, progname, error_string_1, text2=error_string_2) call error_handler(E_MSG, '', '') -ncid = nc_open_file_readonly(filter_io_file, source) +ncid = nc_open_file_readonly(trim(aether_restart_dirname)//'/'//trim(filter_io_file), source) call filter_to_restarts(ncid, member) @@ -115,7 +116,7 @@ subroutine filter_to_restarts(ncid, member) integer, intent(in) :: member, ncid real(r4), allocatable :: fulldom3d(:,:,:) -character(len=256) :: file_root +character(len=64) :: file_root integer :: ivar character(len=vtablenamelength) :: varname, dart_varname @@ -145,7 +146,7 @@ subroutine filter_to_restarts(ncid, member) dart_varname = aether_name_to_dart(varname) file_root = trim(variables(VT_ORIGININDX,ivar)) - if (file_root == 'neutrals') then + if (trim(file_root) == 'neutrals') then ! This parameter is available through the `use netcdf` command. fulldom3d = NF90_FILL_REAL @@ -171,11 +172,11 @@ subroutine filter_to_restarts(ncid, member) file_root = trim(variables(VT_ORIGININDX,ivar)) if (debug >= 0 .and. do_output()) then write(error_string_1,'("varname, dart_varname, file_root = ",3(2x,A))') & - trim(varname), trim(dart_varname), file_root + trim(varname), trim(dart_varname), trim(file_root) call error_handler(E_MSG, routine, error_string_1, source) endif - if (file_root == 'ions') then + if (trim(file_root) == 'ions') then fulldom3d = NF90_FILL_REAL call nc_get_variable(ncid, dart_varname, fulldom3d(1:nlev,1:nlat,1:nlon), & context=routine) @@ -356,7 +357,8 @@ subroutine filter_io_to_blocks(fulldom3d, varname, file_root, member) nb = (jb - 1) * nblocks_lon + ib - 1 - block_file = block_file_name(trim(file_root), member, nb) + write(block_file,'(A,"/",A)') trim(aether_restart_dirname), & + trim(block_file_name(trim(file_root), member, nb)) ncid_output = open_block_file(block_file, 'readwrite') if (.not.nc_variable_exists(ncid_output,varname)) then write(error_string_1,'(4A)') 'variable ', varname, ' does not exist in ',block_file diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index 8da7695e68..426296e536 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -40,7 +40,8 @@ for a member plus grid files, and repackage them into an ensemble state vector f (filter_input.nc). Filter_input.nc has a single domain and no halos. The field names will be transformed into CF-compliant names in filter_input.nc. -``Filter`` will read the ensemble of filter_input.nc files, assimilate, +``Filter`` will read a list of variables from ``model_nml`` (not ``transform_state_nml``), +then read the ensemble of filter_input.nc files, assimilate, and write an ensemble of filter_output.nc files. ``Dart_to_aether`` will convert the fields' names to the CF-compliant filter names, @@ -69,7 +70,7 @@ transform_state_nml is defined by the number of processors used by Aether. variables - The Aether fields to be included in the model state are specified + The Aether fields to be transformed into a model state are specified in the 'variables' namelist variable in transform_state_nml. The following information must be provided for each field @@ -90,8 +91,11 @@ transform_state_nml - Matlab's ``netcdf.rename`` In ``transform_state_nml`` there is no association of DART "quantities" - (QTY\_\*) with fields. Those associations are made in ``model_nml`` - for use by ``filter``. See the :ref:`QTY` section, below. + (QTY\_\*) with fields. + A subset of the transformed variables to be included in the model state + is specified in :ref:`model_nml:variables`, using the CF-compliant names. + That is where the associations with QTYs are made. + See the :ref:`QTY` section, below. The neutrals restart files contain the following fields. The most important fields are **noted in bold text** @@ -122,6 +126,8 @@ transform_state_nml They may be available in the history files. +.. _model_nml: + model_nml ......... @@ -192,18 +198,40 @@ time_step_days, time_step_seconds Usage ----- -To test the transformation of files for member 0: +The workflow and scripting for fully cycling assimilation +(ensemble hindcast, then assimilation, repeat as needed) +has not been defined yet for Aether (2024-2), +but we expect that all of the DART executables will be in a directory +which is defined in the script. +So the script will be able to run the programs using a full pathname. +In addition, all of the Aether restart files will be in a "run" directory, +which has plenty of space for the data. +The DART executables will be run in this directory using their full pathnames. + +To run a more limited test (no assimilation), +which is just the transformation of files for a member (0) +use the following steps. +These build the ``aether_to_dart`` and ``dart_to_aether`` executables +in $DART/models/aether_lat-lon/work directory. +Also in that directory, edit input.nml to set ``transform_state_nml:`` ``aether_restart_dirname`` +to be the full pathname of the directory where the Aether restart and grid files are. + :: +> set exec_dir = $DART/models/aether_lat-lon/work +> cd $exec_dir +> ./quick_build.sh > cd {aether_restart_dirname} > mkdir Orig > cp *m0000* Orig/ -> ./aether_to_dart 0 +> cp ${exec_dir}/input.nml . +> ${exec_dir}/aether_to_dart 0 > cp filter_input_0001.nc filter_output_0001.nc -> ./dart_to_aether 0 +> ${exec_dir}/dart_to_aether 0 -| The filter\_ files will contain the CF-compliant field names which must be used in model_nml:variables. | Compare the modified Aether restart files with those in Orig. +| The filter\_ files will contain the CF-compliant field names + which must be used in ``model_nml:variables``. .. NOTE:: Some halo parts may have no data in them because Aether currently (2024-2) diff --git a/models/aether_lat-lon/transform_state.nml b/models/aether_lat-lon/transform_state.nml index 1ac776fc32..85275b0d88 100644 --- a/models/aether_lat-lon/transform_state.nml +++ b/models/aether_lat-lon/transform_state.nml @@ -1,6 +1,6 @@ &transform_state_nml aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lat-lon/testdata3' + '/Users/raeder/DAI/Manhattan/models/aether_lat-lon/testdata4' variables = 'Temperature', 'neutrals', 'O+', 'ions', diff --git a/models/aether_lat-lon/transform_state_mod.f90 b/models/aether_lat-lon/transform_state_mod.f90 index 25ae590efb..b2946175dc 100644 --- a/models/aether_lat-lon/transform_state_mod.f90 +++ b/models/aether_lat-lon/transform_state_mod.f90 @@ -53,7 +53,7 @@ module transform_state_mod ! namelist parameters with default values. !----------------------------------------------------------------------- -character(len=256) :: aether_restart_dirname = 'none' +character(len=256) :: aether_restart_dirname = '.' ! An ensemble of file names is created using this root and $member in it, integer, parameter :: MAX_STATE_VARIABLES = 100 @@ -149,7 +149,7 @@ subroutine static_init_blocks() ! 2) allocate space for the grids ! 3) read them from the block restart files, could be stretched ... ! Opens and closes the grid block file, but not the filter netcdf file. -call get_grid_from_blocks(aether_restart_dirname) +call get_grid_from_blocks() if( debug > 0 ) then write(error_string_1,'(A,3I5)') 'grid dims are ', nlon, nlat, nlev @@ -281,13 +281,11 @@ end function block_file_name ! This grid is orthogonal and rectangular but can have irregular spacing along ! any of the three dimensions. -subroutine get_grid_from_blocks(dirname) - -character(len=*), intent(in) :: dirname +subroutine get_grid_from_blocks() integer :: nb, offset, ncid, nboff integer :: starts(3), ends(3), xcount, ycount, zcount -character(len=128) :: filename +character(len=256) :: filename real(r4), allocatable :: temp(:,:,:) character(len=*), parameter :: routine = 'get_grid_from_blocks' @@ -295,7 +293,7 @@ subroutine get_grid_from_blocks(dirname) ! Read the x,y,z from a NetCDF block file(s), ! in order to calculate the n[xyz]_per_block dimensions. ! grid_g0000.nc looks like a worthy candidate, but a restart could be used. -write (filename,'(2A)') trim(dirname),'/grid_g0000.nc' +write (filename,'(2A)') trim(aether_restart_dirname),'/grid_g0000.nc' ncid = nc_open_file_readonly(filename, routine) ! The grid (and restart) file variables have halos, so strip them off @@ -308,7 +306,7 @@ subroutine get_grid_from_blocks(dirname) nlat = nblocks_lat * ny_per_block nlev = nblocks_lev * nz_per_block -write(error_string_1,'(3(A,I5))') 'nlon = ', nlon, 'nlat = ', nlat, 'nlev = ', nlev +write(error_string_1,'(3(A,I5))') 'nlon = ', nlon, ', nlat = ', nlat, ', nlev = ', nlev call error_handler(E_MSG, routine, error_string_1, source) allocate( lons( nlon )) @@ -350,7 +348,7 @@ subroutine get_grid_from_blocks(dirname) do nb = 1, nblocks_lon ! filename is trimmed by passage to open_block_file + "len=*" there. - filename = block_file_name('grid', -1, nb-1) + filename = trim(aether_restart_dirname)//'/'//block_file_name('grid', -1, nb-1) ncid = open_block_file(filename, 'read') ! Read 3D array and extract the longitudes of the non-halo data of this block. @@ -373,7 +371,7 @@ subroutine get_grid_from_blocks(dirname) ! Aether's block name counter start with 0, but the lat values can come from ! any lon=const column of blocks. nboff = ((nb - 1) * nblocks_lon) - filename = block_file_name('grid', -1, nboff) + filename = trim(aether_restart_dirname)//'/'//block_file_name('grid', -1, nboff) ncid = open_block_file(filename, 'read') call nc_get_variable(ncid, 'Latitude', & @@ -392,7 +390,7 @@ subroutine get_grid_from_blocks(dirname) ! so we can read it from the first block. ! if this is not the case, this code has to change. -filename = block_file_name('grid', -1, 0) +filename = trim(aether_restart_dirname)//'/'//block_file_name('grid', -1, 0) ncid = open_block_file(filename, 'read') temp = MISSING_R8 diff --git a/models/aether_lat-lon/work/input.nml b/models/aether_lat-lon/work/input.nml index 3630d4774d..db01db3cc6 100644 --- a/models/aether_lat-lon/work/input.nml +++ b/models/aether_lat-lon/work/input.nml @@ -119,7 +119,7 @@ &transform_state_nml aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lat-lon/testdata3' + '/Users/raeder/DAI/Manhattan/models/aether_lat-lon/restart_files' variables = 'Temperature', 'neutrals', 'O+', 'ions', From ecfdb887b1279f78c61007ee30b81b02a7ee2b42 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Mon, 11 Mar 2024 09:00:17 -0400 Subject: [PATCH 116/124] remove expand netcdf program see pull #640 for discussion * does not have the u, v compression --- models/MITgcm_ocean/expand_netcdf.f90 | 149 ------------------------- models/MITgcm_ocean/work/quickbuild.sh | 1 - 2 files changed, 150 deletions(-) delete mode 100644 models/MITgcm_ocean/expand_netcdf.f90 diff --git a/models/MITgcm_ocean/expand_netcdf.f90 b/models/MITgcm_ocean/expand_netcdf.f90 deleted file mode 100644 index f463b82df0..0000000000 --- a/models/MITgcm_ocean/expand_netcdf.f90 +++ /dev/null @@ -1,149 +0,0 @@ -! Uncompress a netcdf fil -program expand_netcdf - -use netcdf_utilities_mod, only: nc_open_file_readonly, nc_get_dimension_size, & - nc_define_dimension, nc_create_file, & - nc_get_variable, nc_close_file, nc_put_variable, & - nc_define_real_variable, nc_end_define_mode, & - nc_add_attribute_to_variable - -use types_mod, only : r4, MISSING_R4 - -use utilities_mod, only : initialize_utilities, finalize_utilities - -use netcdf - -implicit none - -integer :: ncid, ncid_comp, dimid(1), dimlen, ret -integer :: Nx,Ny,Nz -integer :: nvars ! total number of variables in compressed file -integer :: id, n, c! loop variables -integer :: i,j,k, ncomp3d, ncomp2d -character(len=NF90_MAX_NAME) :: varname -real(r4), allocatable :: vals3d(:,:,:), vals2d(:,:), vals_comp(:) -integer, allocatable :: Xcomp_ind(:), Ycomp_ind(:), Zcomp_ind(:) - -call initialize_utilities('expand_netcdf') - -ncid_comp = nc_open_file_readonly('compressed.nc') -ncid = nc_create_file('expanded.nc') - -! get the Nx,Ny,Nz -Nx = nc_get_dimension_size(ncid_comp, 'XC') -Ny = nc_get_dimension_size(ncid_comp, 'YC') -Nz = nc_get_dimension_size(ncid_comp, 'ZC') - -! define Nx,Ny,Nz in the expanded file -call nc_define_dimension(ncid, 'X', Nx) -call nc_define_dimension(ncid, 'Y', Ny) -call nc_define_dimension(ncid, 'Z', Nz) - -! get the compressed size -ncomp2d = nc_get_dimension_size(ncid_comp, 'comp2d') -ncomp3d = nc_get_dimension_size(ncid_comp, 'comp3d') - -allocate(vals_comp(ncomp3d)) -allocate(vals2d(Nx,Ny), vals3d(Nx,Ny,Nz)) - -! read in -allocate(Xcomp_ind(ncomp3d), Ycomp_ind(ncomp3d), Zcomp_ind(ncomp3d)) -call nc_get_variable(ncid_comp, 'Ycomp_ind', Ycomp_ind) -call nc_get_variable(ncid_comp, 'Xcomp_ind', Xcomp_ind) -call nc_get_variable(ncid_comp, 'Zcomp_ind', Zcomp_ind) - - -! get the number of variables -ret = nf90_inquire(ncid_comp, nVariables=nvars) - -! define variables -do id = 1, nvars - ret = nf90_inquire_variable(ncid_comp, id, varname, dimids=dimid) - - ! is a it a compressed state variable? - if (var_of_interest(varname)) then - - ! inquire dimention length (2d or 3d) - ret = nf90_inquire_dimension(ncid_comp, dimid(1), len=dimlen) - - ! define expanded variable - if (dimlen == ncomp3d) then - call nc_define_real_variable(ncid, varname, (/'X','Y','Z'/)) - else - call nc_define_real_variable(ncid, varname, (/'X','Y'/)) - endif - - call nc_add_attribute_to_variable(ncid, varname, 'missing_value', MISSING_R4) - - endif -enddo - -call nc_end_define_mode(ncid) - -! write variables -do id = 1, nvars - ret = nf90_inquire_variable(ncid_comp, id, varname, dimids=dimid) - - ! is a it a compressed state variable? - if (var_of_interest(varname)) then - - ! inquire dimention length (2d or 3d) - ret = nf90_inquire_dimension(ncid_comp, dimid(1), len=dimlen) - - ! read in compressed variable - if (dimlen == ncomp3d) then - call nc_get_variable(ncid_comp, varname, vals_comp) - vals3d = MISSING_R4 - else - call nc_get_variable(ncid_comp, varname, vals_comp(1:ncomp2d)) - vals2d = MISSING_R4 - endif - - ! expand - c = 1 - do n = 1, ncomp3d - i = Xcomp_ind(n) - j = Ycomp_ind(n) - k = Zcomp_ind(n) - if (k == 1 .and. dimlen == ncomp2d) then - vals2d(i,j) = vals_comp(c) - c = c + 1 - else - vals3d(i,j,k) = vals_comp(n) - endif - enddo - - ! write expanded variable - if (dimlen == ncomp3d) then - call nc_put_variable(ncid, varname, vals3d) - else - call nc_put_variable(ncid, varname, vals2d) - endif - - endif -enddo - -call nc_close_file(ncid_comp) -call nc_close_file(ncid) - -call finalize_utilities('expand_netcdf') - -contains - - ! logical to ignore compression variables - function var_of_interest(varname) - character(len=*), intent(in) :: varname - logical :: var_of_interest - - select case (varname) - case ('XGcomp', 'XCcomp', 'YGcomp', 'YCcomp', 'ZCcomp', 'Xcomp_ind', 'Ycomp_ind', 'Zcomp_ind') - var_of_interest = .false. - case ('XC', 'YC', 'ZC', 'XG', 'YG') - var_of_interest = .false. - case default - var_of_interest = .true. - end select - - end function var_of_interest - -end program expand_netcdf diff --git a/models/MITgcm_ocean/work/quickbuild.sh b/models/MITgcm_ocean/work/quickbuild.sh index 1254788940..80731cfd82 100755 --- a/models/MITgcm_ocean/work/quickbuild.sh +++ b/models/MITgcm_ocean/work/quickbuild.sh @@ -34,7 +34,6 @@ model_serial_programs=( dart_to_mit mit_to_dart create_ocean_obs -expand_netcdf ) arguments "$@" From 1ad8f46c9700062f7ffc331e8e5f93303d3500a3 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Mon, 11 Mar 2024 10:27:13 -0600 Subject: [PATCH 117/124] Renamed aether_lon-lat to aether_lat-lon --- index.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/index.rst b/index.rst index 7ded292201..6a57387115 100644 --- a/index.rst +++ b/index.rst @@ -439,7 +439,7 @@ References :hidden: models/9var/readme - models/aether_lon-lat/readme + models/aether_lat-lon/readme models/am2/readme models/bgrid_solo/readme models/cam-fv/readme From 3ac25115a4bcd85c978fd01791c6634e46d7a964 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 12 Mar 2024 09:07:09 -0600 Subject: [PATCH 118/124] Applied suggestions from Moha's first review Made it fail before filter_input.nc is created when the Aether restart set doesn't exist. Updated input.nml with useful values for an assimilation. Deleted matlab function used to import new Aether field names into old Aether restart files. Aether_to_dart works with the new names, so this script will probably never be used again. --- models/aether_lat-lon/aether_to_dart.f90 | 2 +- .../aether_lat-lon/matlab/new_varname_file.m | 155 ------------------ models/aether_lat-lon/readme.rst | 10 -- models/aether_lat-lon/transform_state_mod.f90 | 10 +- models/aether_lat-lon/work/input.nml | 16 +- 5 files changed, 16 insertions(+), 177 deletions(-) delete mode 100644 models/aether_lat-lon/matlab/new_varname_file.m diff --git a/models/aether_lat-lon/aether_to_dart.f90 b/models/aether_lat-lon/aether_to_dart.f90 index 7d69c089e4..dca1ef1c6d 100644 --- a/models/aether_lat-lon/aether_to_dart.f90 +++ b/models/aether_lat-lon/aether_to_dart.f90 @@ -92,7 +92,7 @@ program aether_to_dart ! Convert the files !---------------------------------------------------------------------- -call static_init_blocks() +call static_init_blocks(member) ! Must be after static_init_blocks, which provides filter_io_root from the namelist. write(filter_io_file,'(2A, I0.4, A3)') trim(filter_io_root),'_', member + 1,'.nc' diff --git a/models/aether_lat-lon/matlab/new_varname_file.m b/models/aether_lat-lon/matlab/new_varname_file.m deleted file mode 100644 index d2e0490ff2..0000000000 --- a/models/aether_lat-lon/matlab/new_varname_file.m +++ /dev/null @@ -1,155 +0,0 @@ -function new_varname_file(data_dir, member, nblocks) - -% Converts Aether restart file names to updated (2024-1-17) versions. -% Copy the grid files, for completeness, into a new directory. -% Run in that directory. -% Gets all the contents of the existing files -% and writes them to a new file, with new variable names. -% > new_varname_file(data_dir, member, nblocks) -% -% Files are version=2,netcdf=4.9.0,hdf5=1.12.2 - -% DAI/Aether/Aaron_names/restartOut.Sphere.1member -% neut_old = ["N_4S" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... -% neut_new = ["N" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... -% testdata2 (ensemble from Aaron) -neut_old = ["O" "N" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... - "Temperature" "Zonal Wind" "Meridional Wind" "Vertical Wind"] -neut_new = ["O" "N" "O2" "N2" "NO" "He" "N_2D" "N_2P" "H" "O_1D" "CO2" ... - "Temperature" "velocity_east" "velocity_north" "velocity_up"] -% neut_old = ["N_4S" "Zonal Wind"]; -% neut_new = ["N" "velocity_east"]; - -% ions_old = ["O+2P" "Temperature (bulk ion)" ]; -% ions_new = ["O+_2P" "Temperature_bulk_ion" ]; -% DAI/Aether/Aaron_names/restartOut.Sphere.1member -% ions_old = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+2D" "O+2P" ... -% ions_new = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+_2D" "O+_2P" ... -% testdata2 -ions_old = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+_2D" "O+_2P" ... - "Temperature (bulk ion)" "Temperature (electron)"] -ions_new = ["O+" "O2+" "N2+" "NO+" "N+" "He+" "O+_2D" "O+_2P" ... - "Temperature_bulk_ion" "Temperature_electron"] - -global fname_old fname -format compact - -for b = 0:nblocks-1 - % Neutrals - fname = sprintf('neutrals_m%04d_g%04d.nc', member, b) - fname_old = strcat(data_dir,fname) - - create_file_skel() - add_vars(neut_old, neut_new, b) - - % Ions - fname = sprintf('ions_m%04d_g%04d.nc', member, b) - fname_old = strcat(data_dir,fname) - - create_file_skel() - add_vars(ions_old, ions_new, b) - -end - -%- - - - -function create_file_skel() - -% Create file and define dimensions - - global fname_old fname ncid_old ncid_new - - ncid_old = netcdf.open(fname_old,'NOWRITE'); -% ncdisp(fname_old) - [ndims_old,nvars_old,ngatts_old,unlimdimid] = netcdf.inq(ncid_old); - -% I can't make CLOBBER work with whatever permissions Mac and umask allow, -% so remove any existing file manually. Pathetic. - system(['rm ',fname]); -% Ah, I wish they'd mentioned this in the .create page: -% Add write permission to this directory. -% NOPE, needs to operate on an existing file, which I can't create. Brilliant. -% fileattrib('.',"+w") - cmode = netcdf.getConstant('NETCDF4'); - cmode = bitor(cmode,netcdf.getConstant('CLOBBER')); - ncid_new = netcdf.create(fname,cmode); - -% Get dimensions and write them to the new file. - for d = 1:ndims_old - [dimname, dimlen] = netcdf.inqDim(ncid_old,d-1); - dimid = netcdf.inqDimID(ncid_old,dimname); - dimid = netcdf.defDim(ncid_new,dimname,dimlen); - end - netcdf.endDef(ncid_new); - -%- - - - -function add_vars(vars_old, vars_new, b) - - global fname_old fname ncid_old ncid_new - -% time differs from all the others - data = ncread(fname_old,"time"); - dim_list = {"time"}; - nccreate(fname,"time", Dimensions=dim_list, Datatype="double") - ncwrite(fname,"time",data) - - for n = 1:length(vars_old) - add_var(vars_old(n),vars_new(n), b) - - % Ions; add associated variables - if contains(fname,"ions") & ... - ~contains(vars_old(n),"bulk") & ... - ~contains(vars_old(n),"electron") - add_assoc_vars(vars_old(n), vars_new(n), b) - end - end -% - netcdf.close(ncid_new) - netcdf.close(ncid_old) - -% - - - - -function add_var(var_old, var_new, b) - - global fname_old fname - - if b == 0 - sprintf('Renaming %s to %s',var_old,var_new) - end - - data = ncread(fname_old,var_old); - att = ncreadatt(fname_old,var_old,"units"); - - dim_list = {"z","y","x"}; - nccreate (fname, var_new, Dimensions=dim_list, Datatype="single") - ncwrite (fname, var_new, data) - ncwriteatt(fname, var_new,"units",att) - -%- - - - -function add_assoc_vars(var_old, var_new, b) - -% Variables with names associated with ions. -% example 'Parallel Ion Velocity (Zonal) (O+2P)' ... -% The 'Temperature' part of the names is the same, but other parts are different, -% NOTE: These names have the \s removed, but Matlab+NetCDF puts them back in -% in the new file. - i_assoc_old = [ ... - "Temperature" ... - "Parallel Ion Velocity (Zonal)" ... - "Parallel Ion Velocity (Meridional)" ... - "Parallel Ion Velocity (Vertical)" ... - "Perp. Ion Velocity (Zonal)" ... - "Perp. Ion Velocity (Meridional)" ... - "Perp. Ion Velocity (Vertical)" ]; - i_assoc_new = [ ... - "Temperature" ... - "velocity_parallel_east" ... - "velocity_parallel_north" ... - "velocity_parallel_up" ... - "velocity_perp_east" ... - "velocity_perp_north" ... - "velocity_perp_up" ]; - - for a = 1:7 - i_old = strcat(i_assoc_old(a),' (',var_old,')'); - i_new = strcat(i_assoc_new(a),' (',var_new,')'); - add_var(i_old, i_new, b) - end diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index 426296e536..363f4cb34b 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -80,16 +80,6 @@ transform_state_nml Aether field names are not CF-compliant and are translated to CF-compliant forms by aether_to_dart. - TIP: - If you have a set of files with older Aether field names and want to convert - them to newer, still-non-compliant names, you may be able to use (or modify) - ``./matlab/new_varname_file.m``. As of 2024-2 the following - could not handle the non-compliant names:: - - - NetCDF fortran interface, - - NCO's ``ncrename``, - - Matlab's ``netcdf.rename`` - In ``transform_state_nml`` there is no association of DART "quantities" (QTY\_\*) with fields. A subset of the transformed variables to be included in the model state diff --git a/models/aether_lat-lon/transform_state_mod.f90 b/models/aether_lat-lon/transform_state_mod.f90 index b2946175dc..382fc1599a 100644 --- a/models/aether_lat-lon/transform_state_mod.f90 +++ b/models/aether_lat-lon/transform_state_mod.f90 @@ -114,10 +114,12 @@ module transform_state_mod ! get the Aether grid information ! convert the Aether time into a DART time. -subroutine static_init_blocks() +subroutine static_init_blocks(member) -character(len=128) :: aether_filename -integer :: iunit, io +integer, intent(in) :: member + +character(len=128) :: aether_filename +integer :: iunit, io character(len=*), parameter :: routine = 'static_init_blocks' @@ -163,7 +165,7 @@ subroutine static_init_blocks() call get_time(aether_ref_time, aether_ref_nsecs, aether_ref_ndays) ! Get the model time from a restart file. -aether_filename = block_file_name(variables(VT_ORIGININDX,1), 0, 0) +aether_filename = block_file_name(variables(VT_ORIGININDX,1), member, 0) state_time = read_aether_time(trim(aether_restart_dirname)//'/'//trim(aether_filename)) if ( debug > 0 ) then diff --git a/models/aether_lat-lon/work/input.nml b/models/aether_lat-lon/work/input.nml index db01db3cc6..c793d2cda5 100644 --- a/models/aether_lat-lon/work/input.nml +++ b/models/aether_lat-lon/work/input.nml @@ -6,6 +6,8 @@ / &quality_control_nml + input_qc_threshold = 3.0 + outlier_threshold = 3.0 / &state_vector_io_nml @@ -14,7 +16,7 @@ &perfect_model_obs_nml read_input_state_from_file = .true. single_file_in = .false. - input_state_files = 'wrfinput_d01' + input_state_files = 'pmo not ready for use' init_time_days = -1 init_time_seconds = -1 @@ -80,7 +82,7 @@ obs_window_days = -1, obs_window_seconds = -1, - inf_flavor = 0, 0, + inf_flavor = 5, 0, inf_initial_from_restart = .false., .false., inf_sd_initial_from_restart = .false., .false., inf_deterministic = .true., .true., @@ -88,8 +90,8 @@ inf_lower_bound = 0.0, 1.0, inf_upper_bound = 1000000.0, 1000000.0, inf_damping = 1.0, 1.0, - inf_sd_initial = 0.0, 0.0, - inf_sd_lower_bound = 0.0, 0.0 + inf_sd_initial = 0.6, 0.0, + inf_sd_lower_bound = 0.6, 0.0 inf_sd_max_change = 1.05, 1.05, trace_execution = .false., @@ -119,7 +121,7 @@ &transform_state_nml aether_restart_dirname = - '/Users/raeder/DAI/Manhattan/models/aether_lat-lon/restart_files' + '/Users/raeder/DAI/Manhattan/models/aether_lat-lon/test4' variables = 'Temperature', 'neutrals', 'O+', 'ions', @@ -131,8 +133,8 @@ &model_nml template_file = 'filter_input_0001.nc' - variables = 'Temperature', 'QTY_TEMPERATURE', 'NA', 'NA', 'UPDATE', - 'Opos', 'QTY_DENSITY_ION_OP', 'NA', 'NA', 'UPDATE' + variables = 'Temperature', 'QTY_TEMPERATURE', '0.0', 'NA', 'UPDATE', + 'Opos', 'QTY_DENSITY_ION_OP', '0.0', 'NA', 'UPDATE' time_step_days = 0 time_step_seconds = 3600 / From ca792f2319108525c80b09b79fbec4411a492e1d Mon Sep 17 00:00:00 2001 From: Helen Kershaw <20047007+hkershaw-brown@users.noreply.github.com> Date: Tue, 12 Mar 2024 13:19:37 -0400 Subject: [PATCH 119/124] remove link to aether notes from the days of building CESM --- models/aether_lat-lon/readme.rst | 2 -- 1 file changed, 2 deletions(-) diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index 363f4cb34b..9ce4ffd04d 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -9,8 +9,6 @@ on a logically rectangular grid "lat-lon", or on an the cubed-sphere grid. This is the interface to the lat-lon version. The model code is available on `GitHub `_ . -Additional documentation can be found -`here `_ . Aether writes history and restart files. The restart fields are divided among 2 types of files: neutrals and ions. From 5870ec0fb2830bc7de2c2b3e6100db1e9473de71 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 12 Mar 2024 11:53:13 -0600 Subject: [PATCH 120/124] A few minor fixes salvaged from a stash --- models/aether_lat-lon/readme.rst | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/models/aether_lat-lon/readme.rst b/models/aether_lat-lon/readme.rst index 363f4cb34b..4b146b9073 100644 --- a/models/aether_lat-lon/readme.rst +++ b/models/aether_lat-lon/readme.rst @@ -5,12 +5,10 @@ Overview -------- The Aether ("eether") space weather model can be implemented -on a logically rectangular grid "lat-lon", or on an the cubed-sphere grid. +on a logically rectangular grid "lat-lon", or on a cubed-sphere grid. This is the interface to the lat-lon version. The model code is available on `GitHub `_ . -Additional documentation can be found -`here `_ . Aether writes history and restart files. The restart fields are divided among 2 types of files: neutrals and ions. @@ -200,7 +198,7 @@ The DART executables will be run in this directory using their full pathnames. To run a more limited test (no assimilation), which is just the transformation of files for a member (0) -use the following steps. +use the following csh commands, or equivalents in your preferred languange. These build the ``aether_to_dart`` and ``dart_to_aether`` executables in $DART/models/aether_lat-lon/work directory. Also in that directory, edit input.nml to set ``transform_state_nml:`` ``aether_restart_dirname`` From 6c832fdbb0ec2b0d35f9b213ee13786078609a2b Mon Sep 17 00:00:00 2001 From: kdraeder Date: Tue, 12 Mar 2024 12:12:52 -0600 Subject: [PATCH 121/124] Check for existence of Aether restart in dart_to_aether --- models/aether_lat-lon/dart_to_aether.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/models/aether_lat-lon/dart_to_aether.f90 b/models/aether_lat-lon/dart_to_aether.f90 index 9022167117..c8aab30dcd 100644 --- a/models/aether_lat-lon/dart_to_aether.f90 +++ b/models/aether_lat-lon/dart_to_aether.f90 @@ -77,7 +77,7 @@ program dart_to_aether ! Convert the files !---------------------------------------------------------------------- -call static_init_blocks() +call static_init_blocks(member) write(filter_io_file,'(2A,I0.4,A3)') trim(filter_io_root),'_',member + 1,'.nc' From 8c72bd6a1395570497007196e983b8534f2b8d36 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 12 Mar 2024 15:19:36 -0400 Subject: [PATCH 122/124] bump conf.py and CHANGELOG for release --- CHANGELOG.rst | 4 ++++ conf.py | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.rst b/CHANGELOG.rst index 84bd662946..561f33957a 100644 --- a/CHANGELOG.rst +++ b/CHANGELOG.rst @@ -22,6 +22,10 @@ individual files. The changes are now listed with the most recent at the top. +**March 12 2024 :: Aether lat-lon. Tag v11.2.0** + +- Aether lat-lon interface added to DART. + **March 11 2024 :: SEIR model for infectious diseases. Tag v11.1.0** - Added SEIR model which simulates the spread of infectious diseases, for example COVID-19. diff --git a/conf.py b/conf.py index f55af3ec11..803ce68074 100644 --- a/conf.py +++ b/conf.py @@ -21,7 +21,7 @@ author = 'Data Assimilation Research Section' # The full version, including alpha/beta/rc tags -release = '11.1.0' +release = '11.2.0' root_doc = 'index' # -- General configuration --------------------------------------------------- From 1fe14eafc589aea83f61e03859fc02a3ef9e376e Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 12 Mar 2024 16:54:57 -0400 Subject: [PATCH 123/124] revert netcdf utilties to main, since expand_netcdf.f90 no longer part of this pull request see https://github.com/NCAR/DART/pull/640#discussion_r1511994705 for discussion --- assimilation_code/modules/utilities/netcdf_utilities_mod.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 b/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 index de96188df0..667138cfe5 100644 --- a/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 +++ b/assimilation_code/modules/utilities/netcdf_utilities_mod.f90 @@ -2415,7 +2415,7 @@ function nc_create_file(filename, context) character(len=*), parameter :: routine = 'nc_create_file' integer :: ret, ncid, oldmode -ret = nf90_create(filename, ior(NF90_CLOBBER,NF90_64BIT_OFFSET), ncid) +ret = nf90_create(filename, NF90_CLOBBER, ncid) call nc_check(ret, routine, 'create '//trim(filename)//' read/write', context) call add_fh_to_list(ncid, filename) From 1044da3797af613f3c2916686ec078413f591cc4 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Tue, 12 Mar 2024 17:16:43 -0400 Subject: [PATCH 124/124] bump conf.py and CHANGELOG for release --- CHANGELOG.rst | 8 ++++++++ conf.py | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.rst b/CHANGELOG.rst index 561f33957a..5ad6ff2d62 100644 --- a/CHANGELOG.rst +++ b/CHANGELOG.rst @@ -22,6 +22,14 @@ individual files. The changes are now listed with the most recent at the top. +**March 12 2024 :: MITgcm/N-BLING with Compressed Staggered Grids. Tag v11.3.0** + +- The DART-MITgcm code now supports compressed grids, especially suited for areas like + the Red Sea where land occupies more than 90% of the domain. + Built upon work *contributed by Jiachen Liu*. +- Allows writing the BGC fields into MITgcm's pickup files. +- Allows different compression for the regular and staggered grids. + **March 12 2024 :: Aether lat-lon. Tag v11.2.0** - Aether lat-lon interface added to DART. diff --git a/conf.py b/conf.py index 803ce68074..0dd2606f18 100644 --- a/conf.py +++ b/conf.py @@ -21,7 +21,7 @@ author = 'Data Assimilation Research Section' # The full version, including alpha/beta/rc tags -release = '11.2.0' +release = '11.3.0' root_doc = 'index' # -- General configuration ---------------------------------------------------