From d67b475ee3b9a4c52892a2a35533628ad8662f02 Mon Sep 17 00:00:00 2001 From: Ed Liu Date: Mon, 6 Jun 2022 15:33:06 -0600 Subject: [PATCH 01/43] 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 02/43] 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 03/43] 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 04/43] 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 05/43] 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 06/43] 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 07/43] 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 08/43] 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 09/43] 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 10/43] 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 11/43] 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 12/43] 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 13/43] 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 14/43] 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 15/43] 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 16/43] 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 17/43] 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 18/43] 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 19/43] 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 20/43] 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 21/43] 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 22/43] 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 23/43] 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 24/43] 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 25/43] 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 26/43] 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 27/43] 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 28/43] 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 29/43] 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 30/43] 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 31/43] 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 32/43] 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 33/43] 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 34/43] 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 35/43] 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 36/43] 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 37/43] 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 38/43] 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 39/43] 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 40/43] 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 41/43] 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 42/43] 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 43/43] 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)