From 2a5c85a8ac47a9ce1d80d184cd7c39176b96e4f0 Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 8 Nov 2024 09:16:23 -0500 Subject: [PATCH 1/2] tests: remove non-working and unused tests for state IO fixes #106 (removes dead code) --- developer_tests/io/test_cf_conventions.f90 | 291 ---- developer_tests/io/test_diag_structure.f90 | 150 -- .../io/test_read_write_restarts.f90 | 244 --- developer_tests/io/test_read_write_time.f90 | 112 -- developer_tests/io/test_state_structure.f90 | 1366 ----------------- developer_tests/io/work/cf_test.cdl | 49 - developer_tests/io/work/input.nml | 68 - developer_tests/io/work/quickbuild.sh | 48 - developer_tests/io/work/simple1.cdl | 71 - developer_tests/io/work/simple2.cdl | 68 - developer_tests/io/work/time1.cdl | 24 - developer_tests/io/work/time2.cdl | 25 - developer_tests/io/work/time3.cdl | 25 - developer_tests/io/work/time4.cdl | 29 - 14 files changed, 2570 deletions(-) delete mode 100644 developer_tests/io/test_cf_conventions.f90 delete mode 100644 developer_tests/io/test_diag_structure.f90 delete mode 100644 developer_tests/io/test_read_write_restarts.f90 delete mode 100644 developer_tests/io/test_read_write_time.f90 delete mode 100644 developer_tests/io/test_state_structure.f90 delete mode 100644 developer_tests/io/work/cf_test.cdl delete mode 100644 developer_tests/io/work/input.nml delete mode 100755 developer_tests/io/work/quickbuild.sh delete mode 100644 developer_tests/io/work/simple1.cdl delete mode 100644 developer_tests/io/work/simple2.cdl delete mode 100644 developer_tests/io/work/time1.cdl delete mode 100644 developer_tests/io/work/time2.cdl delete mode 100644 developer_tests/io/work/time3.cdl delete mode 100644 developer_tests/io/work/time4.cdl diff --git a/developer_tests/io/test_cf_conventions.f90 b/developer_tests/io/test_cf_conventions.f90 deleted file mode 100644 index eb7e669a64..0000000000 --- a/developer_tests/io/test_cf_conventions.f90 +++ /dev/null @@ -1,291 +0,0 @@ -! DART software - Copyright UCAR. This open source software is provided -! by UCAR, "as is", without charge, subject to all terms of use at -! http://www.image.ucar.edu/DAReS/DART/DART_download -! -! $Id$ - -program test_cf_conventions - -use types_mod, only : r4, r8, i8, MISSING_R8 , MISSING_R4 -use utilities_mod, only : register_module, error_handler, E_MSG, E_ERR -use adaptive_inflate_mod, only : adaptive_inflate_init -use mpi_utilities_mod, only : initialize_mpi_utilities, finalize_mpi_utilities -use state_vector_io_mod, only : read_state, write_state, state_vector_io_init -use ensemble_manager_mod, only : init_ensemble_manager, ensemble_type, & - set_num_extra_copies -use io_filenames_mod, only : io_filenames_init, io_filenames_finalize, & - file_info_type, netcdf_file_type, READ_COPY, & - set_file_metadata, set_io_copy_flag -use state_structure_mod, only : get_xtype, get_units, get_long_name, & - get_short_name, get_has_missing_value, & - get_FillValue, get_missing_value, & - get_add_offset, get_scale_factor, & - add_domain, state_structure_info, & - get_sum_variables -use time_manager_mod, only : time_type, set_time -use filter_mod, only : filter_set_initial_time -use assert_mod, only : assert_equal - -use netcdf - -implicit none - -! version controlled file description for error handling, do not edit -character(len=256), parameter :: source = & - "$URL$" -character(len=32 ), parameter :: revision = "$Revision$" -character(len=128), parameter :: revdate = "$Date$" - -! this should be a namelist variable -logical :: verbose = .false. - -type(ensemble_type) :: ens_handle -type(file_info_type) :: file_info_input -type(time_type) :: time1 -type(time_type) :: curr_ens_time -character(len=256) :: test_file(1) = "cf_test.nc" - -integer(i8) :: model_size -integer :: num_ens = 1 -integer :: num_extras = 0 -integer :: num_copies - -logical :: read_time_from_file - -integer :: domid = 1 ! only one domain -integer :: var_xtype -character(len=NF90_MAX_NAME) :: var_units, blank_string, var_att_name - -integer :: missINT -real(r4) :: missR4 -real(r8) :: missR8, var_offset, var_scale_factor - -blank_string = ' ' - -! initialize the dart libs -call initialize_module() - -!>@todo FIXME ... add variable E when scale/offset are supported -domid = add_domain(test_file(1), num_vars=4, var_names=(/'A', 'B', 'C', 'D'/)) - -if (verbose) then - call state_structure_info(domid) -endif - -! since we are calling add_domain directly instead of through -! static_assim_model_mod we need to get the total number of -! variables from the state_strucutre_mod instead of using -! get_model_size() -model_size = get_sum_variables(1, 4, domid) - -write(*,*) " model size : ", model_size - -num_copies = num_ens + num_extras - -! initalize routines needed for read_state and write_state -call init_ensemble_manager(ens_handle, num_copies, model_size) -call set_num_extra_copies(ens_handle, num_extras) -call filter_set_initial_time(0,0,time1,read_time_from_file) - -file_info_input = initialize_filenames(test_file) - -curr_ens_time = set_time(0, 0) - -! read in restarts -call read_state(ens_handle, file_info_input, read_time_from_file, time1) - -write(*,*)' ' -write(*,*)'======================================================================' -write(*,*)' Unit Test for CF-Conventions' -write(*,*)'======================================================================' -write(*,*)' ' - - -write(*,*)'Testing get_xtype' - -var_xtype = get_xtype(domid,1) -call assert_equal(var_xtype, NF90_INT, 'variable1:get_xtype') - -var_xtype = get_xtype(domid,2) -call assert_equal(var_xtype, NF90_FLOAT, 'variable2:get_xtype') - -var_xtype = get_xtype(domid,3) -call assert_equal(var_xtype, NF90_DOUBLE, 'variable3:get_xtype') - -var_xtype = get_xtype(domid,4) -call assert_equal(var_xtype, NF90_DOUBLE, 'variable4:get_xtype') - -! test units - -write(*,*)'Testing get_units' - -!> todo FIXME Need a unique prefix so don't confuse with get_unit - -var_units = get_units(domid,1) -call assert_equal(var_units, 'units A', 'variable1:get_units') - -var_units = get_units(domid,2) -call assert_equal(var_units, 'units B', 'variable2:get_units') - -var_units = get_units(domid,3) -call assert_equal(var_units, 'units C', 'variable3:get_units') - -var_units = get_units(domid,4) -call assert_equal(var_units, blank_string, 'variable4:get_units') - - -write(*,*)'Testing get_long_name' - -var_att_name = get_long_name(domid,1) -call assert_equal(var_att_name, 'variable A', 'variable1:get_long_name') - -var_att_name = get_long_name(domid,2) -call assert_equal(var_att_name, 'variable B', 'variable2:get_long_name') - -var_att_name = get_long_name(domid,3) -call assert_equal(var_att_name, 'variable C', 'variable3:get_long_name') - -var_att_name = get_long_name(domid,4) -call assert_equal(var_att_name, blank_string, 'variable4:get_long_name') - - -write(*,*)'Testing get_short_name' - -var_att_name = get_short_name(domid,1) -call assert_equal(var_att_name, 'short A', 'variable1:get_short_name') - -var_att_name = get_short_name(domid,2) -call assert_equal(var_att_name, 'short B', 'variable2:get_short_name') - -var_att_name = get_short_name(domid,3) -call assert_equal(var_att_name, 'short C', 'variable3:get_short_name') - -var_att_name = get_short_name(domid,4) - -call assert_equal(var_att_name, blank_string, 'variable4:get_short_name') - - -write(*,*)'Testing get_missing_value' - -call get_missing_value(domid,1,missINT) -call assert_equal(missINT, -77, 'variable1:get_missing_value') - -call get_missing_value(domid,2,missR4) -call assert_equal(missR4, -777.77_r4, 'variable2:get_missing_value') - -call get_missing_value(domid,3,missR8) -call assert_equal(missR8, -88888.88888_r8, 'variable3:get_missing_value') - -! ! variable 4 has no missing value this will fail -! call get_missing_value(domid,4,missR8) -! call assert_equal(missR8, -88888.88888_r8, 'variable4:get_missing_value') - -write(*,*)'Testing get_FillValue' - -call get_FillValue(domid,1,missINT) -call assert_equal(missINT, -77, 'variable1:get_FillValue') - -call get_FillValue(domid,2,missR4) -call assert_equal(missR4, -777.77_r4, 'variable2:get_FillValue') - -call get_FillValue(domid,3,missR8) -call assert_equal(missR8, -88888.88888_r8, 'variable3:get_FillValue') - -! ! variable 4 has no _FillValue this will fail -! call get_FillValue(domid,4,missR8) -! call assert_equal(missR8, -88888.88888_r8, 'variable4:get_FillValue') - -! write(*,*)'Testing offset and scale factor' - -! this is only for r8 at the moment -! since it is not being used within DART -! NOTE: This test is supposed to break. -! Commenting it out for testing all programs. - -! var_offset = get_add_offset(domid,3) -! call assert_equal(var_offset, 2.0_r8, 'variable3:get_var_offset') -! -! var_offset = get_add_offset(domid,4) -! call assert_equal(var_offset, missR8 , 'variable4:get_var_offset') -! -! -! var_scale_factor = get_scale_factor(domid,3) -! call assert_equal(var_scale_factor, 0.2_r8 , 'variable3:get_scale_factor') -! -! var_scale_factor = get_scale_factor(domid,4) -! call assert_equal(var_scale_factor, missR8 , 'variable3:get_scale_factor') - -write(*,*)' ' -write(*,*)'======================================================================' -write(*,*)' Finished Unit Test' -write(*,*)'======================================================================' -write(*,*)' ' - -call io_filenames_finalize(file_info_input) - -! finalize test_cf_conventions -call error_handler(E_MSG,'test_cf_conventions','Finished successfully.',source,revision,revdate) -call finalize_mpi_utilities() - -! end of main code - - -contains - -!---------------------------------------------------------------------- - -subroutine initialize_module - -call initialize_mpi_utilities('test_cf_conventions') -call register_module(source, revision, revdate) -!call static_init_assim_model() -call state_vector_io_init() - -end subroutine initialize_module - -!---------------------------------------------------------------------- - -function initialize_filenames(filename) result(file_handle) -character(len=*), intent(in) :: filename(:) -type(file_info_type) :: file_handle - -integer :: num_domains = 1 -integer :: imem - -character(len=256), allocatable :: file_array(:,:) -character(len=512) :: my_base, my_desc - -allocate(file_array(num_ens, num_domains)) -file_array = RESHAPE(filename, (/num_ens, num_domains/)) - -call io_filenames_init(file_handle, & - ncopies = 1, & - cycling = .false., & - single_file = .false., & - restart_files = file_array) - -do imem = 1, num_ens - write(my_base,'(A,I2)') 'inens_', imem - write(my_desc,'(A,I2)') 'input ens', imem - call set_file_metadata(file_handle, & - cnum = imem, & - fnames = file_array(imem,:), & - basename = my_base, & - desc = my_desc) - - call set_io_copy_flag(file_handle, & - cnum = imem, & - io_flag = READ_COPY) -enddo - -end function initialize_filenames - -!---------------------------------------------------------------------- - -end program - -! -! $URL$ -! $Id$ -! $Revision$ -! $Date$ diff --git a/developer_tests/io/test_diag_structure.f90 b/developer_tests/io/test_diag_structure.f90 deleted file mode 100644 index eff9f3b468..0000000000 --- a/developer_tests/io/test_diag_structure.f90 +++ /dev/null @@ -1,150 +0,0 @@ -! DART software - Copyright UCAR. This open source software is provided -! by UCAR, "as is", without charge, subject to all terms of use at -! http://www.image.ucar.edu/DAReS/DART/DART_download -! -! $Id$ - -!> Aim: Unit test for create_diagnostic_structure and end_diagnostic_structure -!> Tests: -!> * diag_id should be greater than the number of domains -!> * The number of variables in the diangostic domain should be equal to the -!> sum of the number of variables in every domain -!> * The variable and dimension names should stay the same if there is 1 domain -!> in the state -!> * The variable and dimension names should be appended with _d0# where # is the -!> domain number if there are multiple domains. -!> * If you end the diagnostic structure the number of variables should be 0. -!> * If you end the diagnostic structure the size should be 0. -!> * Test that you can call create and destroy multiple times without error. -!> * Check that you can add_domains until you read max_num_domains then the code -!> should error out (so you can't overwrite the diagnostic domain). - -program test_diag_structure - -use types_mod, only : i8 -use utilities_mod, only : initialize_utilities, finalize_utilities -use state_structure_mod, only : create_diagnostic_structure, end_diagnostic_structure, & - add_domain, get_num_variables, get_num_dims, & - get_num_domains, get_dim_name, get_variable_name, & - get_domain_size -use assert_mod, only : assert_equal, assert_greater, assert_not_equal - -implicit none - -! version controlled file description for error handling, do not edit -character(len=*), parameter :: source = "$URL$" -character(len=*), parameter :: revision = "$Revision$" -character(len=*), parameter :: revdate = "$Date$" - -integer :: diag_id, domain_id -integer(i8) :: model_size, m -integer :: i, j, n - -model_size = 44 - -! init library -call initialize_utilities('test_diag_structure') - -! Add domain -domain_id = add_domain(model_size) - -! Create diagnostic domain -diag_id = create_diagnostic_structure() - -! Test diag_id is greater than num_domains -call assert_greater(diag_id, get_num_domains(), 'diag id') - -! Test number of variables in diag domain is equal to the total -! number of variables in the state -n = 0 -do i = 1, get_num_domains() - do j = 1, get_num_variables(i) - n = n + 1 - enddo -enddo -call assert_equal(n, get_num_variables(diag_id), 'num vars in use') - -print*, '---- single domain -----' -! Print out variable names -do i = 1, get_num_variables(diag_id) - print*, 'var name: ', trim(get_variable_name(diag_id, i)) - print*, ' dim names: ', (trim(get_dim_name(diag_id, i, j)), j = 1, get_num_dims(diag_id, i)) -enddo - -! Test domain_size of diag domain is equal to SUM(domain_sizes) -m = 0 -do i = 1, get_num_domains() - m = m + get_domain_size(i) -enddo -call assert_equal(get_domain_size(diag_id), m, 'size of diag') - -! End diagnostic domain -call end_diagnostic_structure() - -! Try and access diagnostic domain -! Number of variables should be 0 -call assert_equal(get_num_variables(diag_id), 0, 'num vars after ended') - -! Size should be equal to zero -call assert_equal(get_domain_size(diag_id), int(0,i8), 'domain size after ended') - -! Add more domains to the state -print*, '---- multiple domains -----' -domain_id = add_domain(model_size) -domain_id = add_domain(model_size) - -! Create diagnostic domain -diag_id = create_diagnostic_structure() - -! Test number of variables in diag domain is equal to the total -! number of variables in the state -n = 0 -do i = 1, get_num_domains() - do j = 1, get_num_variables(i) - n = n + 1 - enddo -enddo -call assert_equal(n, get_num_variables(diag_id), 'num vars in use') - -! Test domain_size of diag domain is equal to SUM(domain_sizes) -m = 0 -do i = 1, get_num_domains() - m = m + get_domain_size(i) -enddo -call assert_equal(get_domain_size(diag_id), m, 'size of diag') - - -! Print out variable names -do i = 1, get_num_variables(diag_id) - print*, 'var name: ', trim(get_variable_name(diag_id, i)) - print*, ' dim names: ', (trim(get_dim_name(diag_id, i, j)), j = 1, get_num_dims(diag_id, i)) -enddo - -!----------------------------------------------------------------------------- -! Other tests -!----------------------------------------------------------------------------- -! Create diagnostic domain more than once -diag_id = create_diagnostic_structure() -diag_id = create_diagnostic_structure() - -! Destroy diagnostic domain more than once -call end_diagnostic_structure() -call end_diagnostic_structure() - -! Note this errors out so you should have this at the end -! Add domains until you reach max_num_domains -print *, 'this last test is expected to cause a fatal error:' -do i = 1, 20 ! so you don't end up in an infinite loop - domain_id = add_domain(model_size) -enddo -call assert_not_equal(i, 21, 'not reached max_num_domains') - -! This should die -!print*, get_num_dims(diag_id, 1) - -call finalize_utilities() - -!----------------------------------------------------------------------------- - -end program test_diag_structure - diff --git a/developer_tests/io/test_read_write_restarts.f90 b/developer_tests/io/test_read_write_restarts.f90 deleted file mode 100644 index be40ad7708..0000000000 --- a/developer_tests/io/test_read_write_restarts.f90 +++ /dev/null @@ -1,244 +0,0 @@ -! DART software - Copyright UCAR. This open source software is provided -! by UCAR, "as is", without charge, subject to all terms of use at -! http://www.image.ucar.edu/DAReS/DART/DART_download -! -! $Id$ - -program test_read_write_restarts - -use types_mod, only : r8, i8, vtablenamelength -use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, & - find_namelist_in_file, check_namelist_read, & - do_nml_file, do_nml_term, nmlfileunit, to_upper -use mpi_utilities_mod, only : initialize_mpi_utilities, & - finalize_mpi_utilities -use obs_kind_mod, only : get_index_for_quantity -use state_vector_io_mod, only : read_state, write_state -use state_structure_mod, only : add_domain, get_sum_variables -use ensemble_manager_mod, only : init_ensemble_manager, ensemble_type -use io_filenames_mod, only : io_filenames_init, file_info_type, READ_COPY, & - set_file_metadata, set_io_copy_flag, WRITE_COPY -use time_manager_mod, only : time_type -use filter_mod, only : filter_set_initial_time - -implicit none - -! version controlled file description for error handling, do not edit -character(len=256), parameter :: source = & - "$URL$" -character(len=32 ), parameter :: revision = "$Revision$" -character(len=128), parameter :: revdate = "$Date$" - -integer :: num_ens = 1 -integer :: num_domains = 1 -integer :: imem, domid - -type(file_info_type) :: file_input_handle -type(file_info_type) :: file_output_handle - -character(len=256), allocatable :: file_array_input(:,:) -character(len=256), allocatable :: file_array_output(:,:) -character(len=512) :: my_base, my_desc, string1 - -integer :: iunit, io - -type(ensemble_type) :: ens_handle -type(time_type) :: time1 - -logical :: single_file_in = .false. -logical :: read_time_from_file - -integer(i8) :: model_size -integer :: ens_size = 3 - -! Number of fields in the state vector -integer :: nfields - -! DART state vector contents are specified in the input.nml:&model_nml namelist. -integer, parameter :: max_state_variables = 10 -integer, parameter :: num_state_table_columns = 3 -character(len=vtablenamelength) :: variable_table( max_state_variables, num_state_table_columns ) -integer :: state_kinds_list( max_state_variables ) -character(len=vtablenamelength) :: model_variables(max_state_variables * num_state_table_columns ) = ' ' - -! identifiers for variable_table -integer, parameter :: VAR_NAME_INDEX = 1 -integer, parameter :: VAR_QTY_INDEX = 2 -integer, parameter :: VAR_UPDATE_INDEX = 3 - -! namelist variables -character(len=256) :: input_file(1) = "cf_test.nc" -character(len=256) :: output_file(1) = "cf_test_out.nc" -logical :: verbose = .false. - -! namelist items we are going to create/overwrite -namelist /test_read_write_restarts_nml/ input_file, model_variables, verbose - -! main code here - -! initialize the dart libs -call initialize_module() - -! Read back the namelist entry -call find_namelist_in_file("input.nml", "test_read_write_restarts_nml", iunit) -read(iunit, nml = test_read_write_restarts_nml, iostat = io) -call check_namelist_read(iunit, io, "test_read_write_restarts_nml") - -! Record the namelist values used for the run ... -if (do_nml_file()) write(nmlfileunit, nml=test_read_write_restarts_nml) -if (do_nml_term()) write( * , nml=test_read_write_restarts_nml) - -! verify that the model_variables namelist was filled in correctly. -! returns variable_table which has variable names, and kind strings. -call verify_state_variables(model_variables, nfields, variable_table, state_kinds_list) - -domid = add_domain(input_file(1), & - num_vars = nfields, & - var_names = variable_table(1:nfields, VAR_NAME_INDEX), & - kind_list = state_kinds_list) - -! since we are calling add_domain directly instead of through -! static_assim_model_mod we need to get the total number of -! variables from the state_strucutre_mod instead of using -! get_model_size() -model_size = get_sum_variables(1, nfields, domid) - -call init_ensemble_manager(ens_handle, ens_size, model_size) - -call filter_set_initial_time(-1,-1,time1,read_time_from_file) - -! set up the filename handle for reading -file_input_handle = initialize_filenames(input_file, READ_COPY) - -call read_state(ens_handle, file_input_handle, read_time_from_file, time1) - -! set up the filename handle for writing -file_output_handle = initialize_filenames(output_file, WRITE_COPY) - -call write_state(ens_handle, file_output_handle) - -! finalize test_read_write_restarts -call error_handler(E_MSG,'test_read_write_restarts','Finished successfully.',& - source,revision,revdate) - -call finalize_mpi_utilities() - -! end of main code - - -contains - -!---------------------------------------------------------------------- - -subroutine initialize_module - - call initialize_mpi_utilities('test_read_write_restarts') - call register_module(source, revision, revdate) - -end subroutine initialize_module - -!------------------------------------------------------------------ -!> Verify that the namelist was filled in correctly, and check -!> that there are valid entries for the dart_kind. -!> Returns a table with columns: -!> -!> netcdf_variable_name ; dart_kind_string - -subroutine verify_state_variables( state_variables, ngood, table, kind_list) - -character(len=*), intent(inout) :: state_variables(:) -integer, intent(out) :: ngood -character(len=*), intent(out) :: table(:,:) -integer, intent(out) :: kind_list(:) ! kind number - -integer :: nrows, i -character(len=256) :: varname -character(len=32) :: kindstr - -nrows = size(table,1) - -ngood = 0 - -if ( state_variables(1) == ' ' ) then ! no model_variables namelist provided - string1 = 'model_nml:model_variables not specified' - call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate) -endif - -MyLoop : do i = 1, nrows - - varname = trim(state_variables(2*i -1)) - kindstr = trim(state_variables(2*i )) - - table(i,1) = trim(varname) - table(i,2) = trim(kindstr) - - if ( table(i,1) == ' ' .and. table(i,2) == ' ') exit MyLoop ! Found end of list. - - if ( table(i,1) == ' ' .and. table(i,2) == ' ') then - string1 = 'model_nml:model_variables not fully specified' - call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate) - endif - - ! Make sure DART kind is valid - - kind_list(i) = get_index_for_quantity(kindstr) - if( kind_list(i) < 0 ) then - write(string1,'(''there is no obs_kind <'',a,''> in obs_kind_mod.f90'')') trim(kindstr) - call error_handler(E_ERR,'verify_state_variables',string1,source,revision,revdate) - endif - - ! Record the contents of the DART state vector - - if (verbose) then - write(string1,'(A,I2,6A)') 'variable ',i,' is ',trim(varname), ', ', trim(kindstr) - call error_handler(E_MSG,'verify_state_variables',string1,source,revision,revdate) - endif - - ngood = ngood + 1 -enddo MyLoop - -end subroutine verify_state_variables - -!---------------------------------------------------------------------- - -function initialize_filenames(filename, IO_STRING) result (file_handle) -character(len=*), intent(in) :: filename(:) -integer, intent(in) :: IO_STRING -type(file_info_type) :: file_handle - -character(len=256), allocatable :: file_array(:,:) - -allocate(file_array(num_ens, num_domains)) -file_array = RESHAPE(filename, (/num_ens, num_domains/)) - -call io_filenames_init(file_handle, & - ncopies = 1, & - cycling = .false., & - single_file = single_file_in, & - restart_files = file_array) - -do imem = 1, num_ens - write(my_base,'(A,I2)') 'outens_', imem - write(my_desc,'(A,I2)') 'output ens', imem - call set_file_metadata(file_handle, & - cnum = imem, & - fnames = file_array(imem,:), & - basename = my_base, & - desc = my_desc) - - call set_io_copy_flag(file_handle, & - cnum = imem, & - io_flag = IO_STRING) -enddo - -end function - -!---------------------------------------------------------------------- - -end program - -! -! $URL$ -! $Id$ -! $Revision$ -! $Date$ diff --git a/developer_tests/io/test_read_write_time.f90 b/developer_tests/io/test_read_write_time.f90 deleted file mode 100644 index a46f07b272..0000000000 --- a/developer_tests/io/test_read_write_time.f90 +++ /dev/null @@ -1,112 +0,0 @@ -! DART software - Copyright UCAR. This open source software is provided -! by UCAR, "as is", without charge, subject to all terms of use at -! http://www.image.ucar.edu/DAReS/DART/DART_download - -!>@todo FIXME - add more tests ... wrong calendars, etc. - -program test_read_write_time - -use types_mod, only : r8, i8 -use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG, & - find_namelist_in_file, check_namelist_read, & - do_nml_file, do_nml_term, nmlfileunit, to_upper, & - initialize_utilities, finalize_utilities - -use netcdf_utilities_mod, only : nc_open_file_readwrite, nc_close_file -use dart_time_io_mod, only : read_model_time, write_model_time -use time_manager_mod, only : time_type, set_calendar_type, get_calendar_type, & - set_time, print_time, operator(+) - -implicit none - -! version controlled file description for error handling, do not edit -character(len=*), parameter :: source = 'test_read_write_time.f90' -character(len=*), parameter :: revision = '' -character(len=*), parameter :: revdate = '' - -character(len=512) :: msgstring - -integer :: iunit, io, ncid, i -integer, parameter :: MAXFILES = 100 - -type(time_type) :: mytime - -! namelist variables -character(len=256) :: input_file(MAXFILES) = "" -logical :: verbose = .false. - -! namelist items we are going to create/overwrite -namelist /test_read_write_time_nml/ input_file, verbose - - -! main code here - -! initialize the dart libs -call initialize_module() - -! Read back the namelist entry -call find_namelist_in_file("input.nml", "test_read_write_time_nml", iunit) -read(iunit, nml = test_read_write_time_nml, iostat = io) -call check_namelist_read(iunit, io, "test_read_write_time_nml") - -! Record the namelist values used for the run ... -if (do_nml_file()) write(nmlfileunit, nml=test_read_write_time_nml) -if (do_nml_term()) write( * , nml=test_read_write_time_nml) - -call error_handler(E_MSG, "", "") - -! intent is to open a list of netcdf files with various permutations -! of time variable, dimension, size, etc and see if read/write model time -! routines (the default ones) work or error out correctly - -do i = 1, MAXFILES - if (input_file(i) == "") exit - - ! to test: - ! function read_model_time(filename) - ! subroutine write_model_time(ncid, dart_time) - - mytime = read_model_time(input_file(i)) - - call print_time(mytime,'read_model_time first') - - mytime = mytime + set_time(0, 1) - - ncid = nc_open_file_readwrite(input_file(i)) - call write_model_time(ncid, mytime) - call nc_close_file(ncid) - - mytime = read_model_time(input_file(i)) - call print_time(mytime,'read_model_time second') - -enddo - - -call finalize_module() - -! end of main code - - -contains - -!---------------------------------------------------------------------- - -subroutine initialize_module - -call initialize_utilities('test_read_write_time') -call register_module(source, revision, revdate) - -end subroutine initialize_module - -!---------------------------------------------------------------------- - -subroutine finalize_module - -call finalize_utilities('test_read_write_time') - -end subroutine finalize_module - -!---------------------------------------------------------------------- - -end program - diff --git a/developer_tests/io/test_state_structure.f90 b/developer_tests/io/test_state_structure.f90 deleted file mode 100644 index 681c099314..0000000000 --- a/developer_tests/io/test_state_structure.f90 +++ /dev/null @@ -1,1366 +0,0 @@ -! DART software - Copyright UCAR. This open source software is provided -! by UCAR, "as is", without charge, subject to all terms of use at -! http://www.image.ucar.edu/DAReS/DART/DART_download -! -! $Id$ - -program test_state_structure - -use types_mod, only : r8, i8, i4, MISSING_R8 - -use utilities_mod, only : register_module, initialize_utilities, & - finalize_utilities, error_handler, & - E_ERR, E_MSG - -use obs_kind_mod, only : get_name_for_quantity, & - QTY_U_WIND_COMPONENT, & - QTY_V_WIND_COMPONENT, & - QTY_SURFACE_PRESSURE, & - QTY_STATE_VARIABLE, & - QTY_TEMPERATURE, & - QTY_SALINITY - -use assert_mod, only : assert_equal - -use state_structure_mod, only : add_domain, & - get_domain_size, & - get_num_domains, & - get_variable_size, & - get_variable_name, & - get_num_variables, & - get_num_dims, & - get_dim_lengths, & - get_dim_length, & - add_dimension_to_variable, & - finished_adding_domain, & - state_structure_info, & - get_kind_string, & - get_kind_index, & - get_varid_from_kind, & - get_varids_from_kind, & - get_dim_name, & - get_io_num_dims, & - get_io_dim_ids, & - get_io_dim_lengths, & - get_io_num_unique_dims, & - get_io_unique_dim_name, & - get_io_unique_dim_length, & - add_time_unlimited, & - get_unlimited_dimid, & - set_var_id, & - get_io_clamping_maxval, & - get_io_clamping_minval, & - do_io_clamping, & - do_io_update, & - get_index_start, & - get_index_end, & - get_sum_variables, & - get_sum_variables_below, & - get_model_variable_indices, & - get_dart_vector_index, & - get_num_varids_from_kind - -use netcdf - -implicit none - -! version controlled file description for error handling, do not edit -character(len=256), parameter :: source = & - "$URL$" -character(len=32 ), parameter :: revision = "$Revision$" -character(len=128), parameter :: revdate = "$Date$" - -! global variables -integer, parameter :: VAR1 = 1 -integer, parameter :: VAR2 = 2 -integer, parameter :: VAR3 = 3 -integer, parameter :: VAR4 = 4 -integer, parameter :: VAR5 = 5 ! variable does not exist - -integer, parameter :: DIM1 = 1 -integer, parameter :: DIM2 = 2 -integer, parameter :: DIM3 = 3 -integer, parameter :: DIM4 = 4 - -integer, parameter :: b1sz = 100 -integer, parameter :: b2sz = 10 - -! number of variables for adding domain from file -integer, parameter :: f1nv = 4 -integer, parameter :: f2nv = 3 - -! number of variables for adding domain from spec -integer, parameter :: spnv = 4 - -! spec dimension sizes -integer, parameter :: nsd1 = 2 -integer, parameter :: nsd2 = 3 -integer, parameter :: nsd3 = 4 -integer, parameter :: nsd4 = 5 - -! spec dimension sizes -integer, parameter :: nsdid1 = 1 -integer, parameter :: nsdid2 = 2 -integer, parameter :: nsdid3 = 3 -integer, parameter :: nsdid4 = 4 - -! spec variable sizes -integer, parameter :: spv1sz = nsd1 -integer, parameter :: spv2sz = nsd1*nsd2 -integer, parameter :: spv3sz = nsd1*nsd2*nsd3 -integer, parameter :: spv4sz = nsd1*nsd2*nsd3*nsd4 - -! file dimension sizes -integer, parameter :: f1d1 = 3 -integer, parameter :: f1d2 = 4 -integer, parameter :: f1d3 = 5 -integer, parameter :: f1d4 = 1 - -integer, parameter :: f2d1 = 4 -integer, parameter :: f2d2 = 5 -integer, parameter :: f2d3 = 6 -integer, parameter :: f2d4 = 1 - -! file dimension ids -integer, parameter :: f1did1 = 1 -integer, parameter :: f1did2 = 4 -integer, parameter :: f1did3 = 5 -integer, parameter :: f1did4 = 7 - -integer, parameter :: f2did1 = 1 -integer, parameter :: f2did2 = 2 -integer, parameter :: f2did3 = 3 -integer, parameter :: f2did4 = 4 - -integer, parameter :: f1v1sz = f1d1 -integer, parameter :: f1v2sz = f1d1 -integer, parameter :: f1v3sz = f1d1 -integer, parameter :: f1v4sz = f1d1*f1d2*f1d3 - -integer, parameter :: f2v1sz = f2d1 -integer, parameter :: f2v2sz = f2d1 -integer, parameter :: f2v3sz = f2d1*f2d2*f2d3 - -! domain sizes -integer(i8), parameter :: dsize1 = b1sz -integer(i8), parameter :: dsize2 = b2sz -integer(i8), parameter :: dsize3 = f1v1sz+f1v2sz+f1v3sz+f1v4sz -integer(i8), parameter :: dsize4 = f2v1sz+f2v2sz+f2v3sz -integer(i8), parameter :: dsize5 = spv1sz+spv2sz+spv3sz+spv4sz - -! model sizes after adding a domain -integer(i8), parameter :: msize1 = dsize1 -integer(i8), parameter :: msize2 = dsize1+dsize2 -integer(i8), parameter :: msize3 = dsize1+dsize2+dsize3 -integer(i8), parameter :: msize4 = dsize1+dsize2+dsize3+dsize4 -integer(i8), parameter :: msize5 = dsize1+dsize2+dsize3+dsize4+dsize5 - -integer :: did1, did2, did3, did4, did5 - -integer, parameter :: ndoms = 5 - -integer(i8), parameter, dimension(ndoms+1) :: msize = (/ 0_i8, msize1, msize2, msize3, msize4, msize5 /) - -! simple1.nc metadata -character(len=NF90_MAX_NAME), dimension(f1nv) :: var_names1 -integer, dimension(f1nv) :: kind_list1 -real(r8), dimension(f1nv,2) :: clamp_vals1 -logical, dimension(f1nv) :: update_list1 - -! simple2.nc metadata -character(len=NF90_MAX_NAME), dimension(f2nv) :: var_names2 -integer, dimension(f2nv) :: kind_list2 -real(r8), dimension(f2nv,2) :: clamp_vals2 -logical, dimension(f2nv) :: update_list2 - -! domain information for add_domain_from_spec -character(len=NF90_MAX_NAME), dimension(spnv) :: var_names3 -integer, dimension(spnv) :: kind_list3 -real(r8), dimension(spnv,2) :: clamp_vals3 -logical, dimension(spnv) :: update_list3 - -character(len=32) :: kindString -character(len=NF90_MAX_NAME) :: varName -integer(i8) :: int8Val -integer :: intVal -real(r8) :: realVal -logical :: trueFalse - -integer(i8) :: state_indx -integer :: dom - -character(len=512) :: string1 - -! namelist variables -logical :: debug = .false. - -! namelist items we are going to create/overwrite -namelist /test_state_structure_nml/ debug - -! main code here - -! initialize the dart libs -call initialize_module() - -call error_handler(E_ERR,'test_state_structure ',& - 'Has not been tested yet with new naming conventions.',source,revision,revdate) - -call initialize_domains() - -did1 = add_domain(int(b1sz,i8)) -did2 = add_domain(int(b2sz,i8)) -did3 = add_domain('simple1.nc', f1nv, var_names1, & - kind_list1, clamp_vals1, update_list1) -did4 = add_domain('simple2.nc', f2nv, var_names2, & - kind_list2, clamp_vals2, update_list2) -did5 = add_domain(spnv, var_names3, kind_list3, clamp_vals3, update_list3) - -! add dimensions for domains from spec -call fill_domain_structure_for_spec(did5) - -if ( debug ) then - write(*,*) - write(*,*)'==============================================================' - write(*,*)'State structure information.' - write(*,*)'==============================================================' - write(*,*) - - call state_structure_info(did1) - call state_structure_info(did2) - call state_structure_info(did3) - call state_structure_info(did4) - call state_structure_info(did5) -endif - -write(*,*) -write(*,*)'==============================================================' -write(*,*)'Testing domain sizes.' -write(*,*)'==============================================================' -write(*,*) - -call assert_equal(get_num_domains(), ndoms, 'get_num_domains') - -write(*,*)' ... Testing Domain 1' -call test_sizes_domain(did1, exp_dom_size = b1sz, & - exp_num_dom_vars = 1, & ! only one var for blank - exp_unlim_dimid = -1) ! no unlim dim - -write(*,*)' ... Testing Domain 2' -call test_sizes_domain(did2, exp_dom_size = b2sz, & - exp_num_dom_vars = 1, & - exp_unlim_dimid = -1) - -write(*,*)' ... Testing Domain 3' -call test_sizes_domain(did3, exp_dom_size = f1v1sz+f1v2sz+f1v3sz+f1v4sz, & - exp_num_dom_vars = 4, & - exp_unlim_dimid = 7) - -write(*,*)' ... Testing Domain 4' -call test_sizes_domain(did4, exp_dom_size = f2v1sz+f2v2sz+f2v3sz, & - exp_num_dom_vars = 3, & - exp_unlim_dimid = 4) - -write(*,*)' ... Testing Domain 5' -call test_sizes_domain(did5, exp_dom_size = spv1sz+spv2sz+spv3sz+spv4sz, & - exp_num_dom_vars = 4, & - exp_unlim_dimid = -1) - -write(*,*) -write(*,*)'==============================================================' -write(*,*)'Testing variable information.' -write(*,*)'==============================================================' -write(*,*) - -write(*,*)' ... Testing Domain 1' -call test_variable_info(did1, VAR1, & - exp_var_size = b1sz, & - exp_num_dims = 1, & - exp_kind_indx = QTY_STATE_VARIABLE, & - exp_kind_string = 'QTY_STATE_VARIABLE',& - exp_var_name = 'state') - -write(*,*)' ... Testing Domain 2' -call test_variable_info(did2, VAR1, & - exp_var_size = b2sz, & - exp_num_dims = 1, & - exp_kind_indx = QTY_STATE_VARIABLE, & - exp_kind_string = 'QTY_STATE_VARIABLE',& - exp_var_name = 'state') - -write(*,*)' ... Testing Domain 3 Var 1' -call test_variable_info(did3, VAR1, & - exp_var_size = f1d1, & - exp_num_dims = 1, & - exp_kind_indx = QTY_STATE_VARIABLE, & - exp_kind_string = 'QTY_STATE_VARIABLE',& - exp_var_name = 'A') - -write(*,*)' ... Testing Domain 3 Var 4' -call test_variable_info(did3, VAR4, & - exp_var_size = f1d1*f1d2*f1d3, & - exp_num_dims = 3, & - exp_kind_indx = QTY_TEMPERATURE, & - exp_kind_string = 'QTY_TEMPERATURE',& - exp_var_name = 'temp') - -write(*,*)' ... Testing Domain 4 Var 1' -call test_variable_info(did4, VAR1, & - exp_var_size = f2d1, & - exp_num_dims = 1, & - exp_kind_indx = QTY_STATE_VARIABLE, & - exp_kind_string = 'QTY_STATE_VARIABLE',& - exp_var_name = 'B') - -call test_variable_info(did4, VAR3, & - exp_var_size = f2d1*f2d2*f2d3, & - exp_num_dims = 3, & - exp_kind_indx = QTY_TEMPERATURE, & - exp_kind_string = 'QTY_TEMPERATURE',& - exp_var_name = 'temp') - -write(*,*)' ... Testing Domain 5 Var 1' -call test_variable_info(did5, VAR1, & - exp_var_size = spv1sz, & - exp_num_dims = 1, & - exp_kind_indx = QTY_SURFACE_PRESSURE, & - exp_kind_string = 'QTY_SURFACE_PRESSURE',& - exp_var_name = 'PS') - -write(*,*)' ... Testing Domain 5 Var 4' -call test_variable_info(did5, VAR4, & - exp_var_size = spv4sz, & - exp_num_dims = 4, & - exp_kind_indx = QTY_V_WIND_COMPONENT, & - exp_kind_string = 'QTY_V_WIND_COMPONENT',& - exp_var_name = 'V ') - -write(*,*) -write(*,*)'==============================================================' -write(*,*)'Testing dimension information.' -write(*,*)'==============================================================' -write(*,*) - -write(*,*)' ... Testing Domain 1 Var 1' -call test_dimension_info(did1, VAR1, & - dim_ids = (/DIM1/), & - exp_dim_names = (/'domain_size'/), & - exp_dim_lengths = (/b1sz/), & - io_dim_ids = (/DIM1/), & - exp_io_numdims = 1, & - exp_io_dim_names = (/'domain_size'/), & - exp_io_dim_lengths = (/ b1sz/), & - exp_io_dim_ids = (/ 1/), & - exp_io_unique_dim_ids = (/1/), & - exp_io_unique_numdims = 1, & - exp_io_unique_dim_length = (/ b1sz/), & - exp_io_unique_dim_names = (/'domain_size'/) ) - -write(*,*)' ... Testing Domain 2 Var 1' -call test_dimension_info(did2, VAR1, & - dim_ids = (/DIM1/), & - exp_dim_names = (/'domain_size'/), & - exp_dim_lengths = (/b2sz/), & - io_dim_ids = (/DIM1/), & - exp_io_numdims = 1, & - exp_io_dim_names = (/'domain_size'/), & - exp_io_dim_lengths = (/ b2sz/), & - exp_io_dim_ids = (/ 1/), & - exp_io_unique_dim_ids = (/1/), & - exp_io_unique_numdims = 1, & - exp_io_unique_dim_length = (/ b2sz/), & - exp_io_unique_dim_names = (/'domain_size'/) ) - -write(*,*)' ... Testing Domain 3 Var 1' -call test_dimension_info(did3, VAR1, & - dim_ids = (/DIM1/), & - exp_dim_names = (/'level'/), & - exp_dim_lengths = (/ f1d1/), & - io_dim_ids = (/DIM1/), & - exp_io_numdims = 1, & - exp_io_dim_names = (/'level', 'lat ', 'lon ', 'time '/), & - exp_io_dim_lengths = (/ f1d1/), & - exp_io_dim_ids = (/DIM1/), & - exp_io_unique_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), & - exp_io_unique_numdims = 4, & - exp_io_unique_dim_length = (/ f1d1, f1d2, f1d3, f1d4/), & - exp_io_unique_dim_names = (/'level', 'lat ', 'lon ','time '/) ) - -write(*,*)' ... Testing Domain 3 Var 4' -call test_dimension_info(did3, VAR4, & - dim_ids = (/DIM1, DIM2, DIM3/), & - exp_dim_names = (/'level', 'lat ', 'lon '/), & - exp_dim_lengths = (/ f1d1, f1d2, f1d3/), & - io_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), & - exp_io_numdims = 4, & - exp_io_dim_names = (/'level', 'lat ', 'lon ','time '/), & - exp_io_dim_lengths = (/ f1d1, f1d2, f1d3, f1d4/), & - exp_io_dim_ids = (/f1did1, f1did2, f1did3, f1did4/), & - exp_io_unique_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), & - exp_io_unique_numdims = 4, & - exp_io_unique_dim_length = (/ f1d1, f1d2, f1d3, f1d4/), & - exp_io_unique_dim_names = (/'level', 'lat ', 'lon ','time '/) ) - -write(*,*)' ... Testing Domain 4 Var 2' -call test_dimension_info(did4, VAR2, & - dim_ids = (/DIM1/), & - exp_dim_names = (/'level'/), & - exp_dim_lengths = (/ f2d1/), & - io_dim_ids = (/DIM1/), & - exp_io_numdims = 1, & - exp_io_dim_names = (/'level'/), & - exp_io_dim_lengths = (/ f2d1/), & - exp_io_dim_ids = (/ f2did1/), & - exp_io_unique_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), & - exp_io_unique_numdims = 4, & - exp_io_unique_dim_length = (/ f2d1, f2d2, f2d3, f2d4/), & - exp_io_unique_dim_names = (/'level', 'lat ', 'lon ','time '/) ) - -write(*,*)' ... Testing Domain 4 Var 3' -call test_dimension_info(did4, VAR3, & - dim_ids = (/DIM1, DIM2, DIM3/), & - exp_dim_names = (/'level', 'lat ', 'lon '/), & - exp_dim_lengths = (/ f2d1, f2d2, f2d3/), & - io_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), & - exp_io_numdims = 4, & - exp_io_dim_names = (/'level', 'lat ', 'lon ','time '/), & - exp_io_dim_lengths = (/ f2d1, f2d2, f2d3, f2d4/), & - exp_io_dim_ids = (/ f2did1, f2did2, f2did3, f2did4/), & - exp_io_unique_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), & - exp_io_unique_numdims = 4, & - exp_io_unique_dim_length = (/ f2d1, f2d2, f2d3, f2d4/), & - exp_io_unique_dim_names = (/'level', 'lat ', 'lon ','time '/) ) - -write(*,*)' ... Testing Domain 5 Var 2' -call test_dimension_info(did5, VAR2, & - dim_ids = (/DIM1, DIM2/), & - exp_dim_names = (/'dim1', 'dim2'/), & - exp_dim_lengths = (/ nsd1, nsd2/), & - io_dim_ids = (/DIM1, DIM2/), & - exp_io_numdims = 2, & - exp_io_dim_names = (/'dim1', 'dim2'/), & - exp_io_dim_lengths = (/ nsd1, nsd2/), & - exp_io_dim_ids = (/ nsdid1, nsdid2/), & - exp_io_unique_dim_ids = (/1,2,3,4,5,6,7,8,9,10/), & - exp_io_unique_numdims = 10, & - exp_io_unique_dim_length = (/ nsd1, & - nsd1, nsd2, & - nsd1, nsd2, nsd3, & - nsd1, nsd2, nsd3,nsd4/), & - exp_io_unique_dim_names = (/'dim1', & - 'dim1', 'dim2', & - 'dim1', 'dim2', 'dim3', & - 'dim1', 'dim2', 'dim3', 'dim4'/) ) -write(*,*)' ... Testing Domain 5 Var 4' -call test_dimension_info(did5, VAR4, & - dim_ids = (/DIM1, DIM2, DIM3, DIM4/), & - exp_dim_names = (/'dim1', 'dim2', 'dim3', 'dim4'/), & - exp_dim_lengths = (/ nsd1, nsd2, nsd3, nsd4/), & - io_dim_ids = (/DIM1, DIM2, DIM3, DIM4/), & - exp_io_numdims = 4, & - exp_io_dim_names = (/'dim1', 'dim2', 'dim3', 'dim4'/), & - exp_io_dim_lengths = (/ nsd1, nsd2, nsd3, nsd4/), & - exp_io_dim_ids = (/ nsdid1, nsdid2, nsdid3, nsdid4/), & - exp_io_unique_dim_ids = (/1,2,3,4,5,6,7,8,9,10/), & - exp_io_unique_numdims = 10, & - exp_io_unique_dim_length = (/ nsd1, & - nsd1, nsd2, & - nsd1, nsd2, nsd3, & - nsd1, nsd2, nsd3,nsd4/), & - exp_io_unique_dim_names = (/'dim1', & - 'dim1', 'dim2', & - 'dim1', 'dim2', 'dim3', & - 'dim1', 'dim2', 'dim3', 'dim4'/) ) - -write(*,*) -write(*,*)'==============================================================' -write(*,*)'Testing update and clamping.' -write(*,*)'==============================================================' -write(*,*) - -write(*,*)' ... Testing Domain 1 Var 1' -call test_update_and_clamping(did1, VAR1, & - exp_clamp_min = MISSING_R8, & - exp_clamp_max = MISSING_R8, & - exp_clamping = .false., & - exp_update = .true.) - -write(*,*)' ... Testing Domain 2 Var 1' -call test_update_and_clamping(did2, VAR1, & - exp_clamp_min = MISSING_R8, & - exp_clamp_max = MISSING_R8, & - exp_clamping = .false., & - exp_update = .true.) - -write(*,*)' ... Testing Domain 3 Var 1' -call test_update_and_clamping(did3, VAR1, & - exp_clamp_min = clamp_vals1(VAR1,1), & - exp_clamp_max = clamp_vals1(VAR1,2), & - exp_clamping = .true., & - exp_update = update_list1(VAR1)) - -write(*,*)' ... Testing Domain 3 Var 4' -call test_update_and_clamping(did3, VAR4, & - exp_clamp_min = clamp_vals1(VAR4,1), & - exp_clamp_max = clamp_vals1(VAR4,2), & - exp_clamping = .true., & - exp_update = update_list1(VAR4)) - -write(*,*)' ... Testing Domain 4 Var 1' -call test_update_and_clamping(did4, VAR1, & - exp_clamp_min = clamp_vals2(VAR1,1), & - exp_clamp_max = clamp_vals2(VAR1,2), & - exp_clamping = .false., & - exp_update = update_list1(VAR1)) - -write(*,*)' ... Testing Domain 4 Var 3' -call test_update_and_clamping(did4, VAR3, & - exp_clamp_min = clamp_vals2(VAR3,1), & - exp_clamp_max = clamp_vals2(VAR3,2), & - exp_clamping = .true., & - exp_update = update_list1(VAR3)) - -write(*,*)' ... Testing Domain 5 Var 1' -call test_update_and_clamping(did5, VAR1, & - exp_clamp_min = clamp_vals3(VAR1,1), & - exp_clamp_max = clamp_vals3(VAR1,2), & - exp_clamping = .false., & - exp_update = update_list3(VAR1)) - -write(*,*)' ... Testing Domain 5 Var 3' -call test_update_and_clamping(did5, VAR3, & - exp_clamp_min = clamp_vals3(VAR3,1), & - exp_clamp_max = clamp_vals3(VAR3,2), & - exp_clamping = .true., & - exp_update = update_list3(VAR3)) - -write(*,*) -write(*,*)'==============================================================' -write(*,*)'Testing start and end indices' -write(*,*)'==============================================================' -write(*,*) - -write(*,*)' ... Testing Domain 1 Var 1' -call test_indices(did1, VAR1, & - var_name = 'state', & - exp_start = int(1,i8) , & - exp_end = int(b1sz,i8)) - -write(*,*)' ... Testing Domain 2 Var 1' -call test_indices(did2, VAR1, & - var_name = 'state', & - exp_start = msize1+1 , & - exp_end = msize1+b2sz) - -write(*,*)' ... Testing Domain 3 Var 1' -call test_indices(did3, VAR1, & - var_name = 'A', & - exp_start = msize2+1 , & - exp_end = msize2+f1v1sz ) - -write(*,*)' ... Testing Domain 3 Var 4' -call test_indices(did3, VAR4, & - var_name = 'temp', & - exp_start = msize2+1+f1v1sz+f1v2sz+f1v3sz, & - exp_end = msize2+ f1v1sz+f1v2sz+f1v3sz+f1v4sz ) - -write(*,*)' ... Testing Domain 4 Var 1' -call test_indices(did4, VAR1, & - var_name = 'B', & - exp_start = msize3+1 , & - exp_end = msize3+f2v1sz ) - -write(*,*)' ... Testing Domain 4 Var 3' -call test_indices(did4, VAR3, & - var_name = 'temp', & - exp_start = msize3+1+f2v1sz+f2v2sz, & - exp_end = msize3 + f2v1sz+f2v2sz+f2v3sz ) - -write(*,*)' ... Testing Domain 5 Var 2' -call test_indices(did5, VAR2, & - var_name = 'T', & - exp_start = msize4+1+spv1sz, & - exp_end = msize4 + spv1sz +spv2sz ) - -write(*,*)' ... Testing Domain 5 Var 4' -call test_indices(did5, VAR4, & - var_name = 'V', & - exp_start = msize4+1+spv1sz+spv2sz+spv3sz, & - exp_end = msize4 + spv1sz+spv2sz+spv3sz+spv4sz ) - -write(*,*) -write(*,*)'==============================================================' -write(*,*)'Testing sum variables below' -write(*,*)'==============================================================' -write(*,*) - -write(*,*)' ... Testing Domain 1 Var 1' -call test_sum_variables_below(did1, VAR1, VAR1, & - exp_sum_range = int(b1sz,i8), & - exp_sum_below1 = int(0,i8), & - exp_sum_below2 = int(0,i8)) - -write(*,*)' ... Testing Domain 2 Var 1' -call test_sum_variables_below(did2, VAR1, VAR1, & - exp_sum_range = int(b2sz,i8), & - exp_sum_below1 = int(b1sz,i8), & - exp_sum_below2 = int(b1sz,i8)) - -write(*,*)' ... Testing Domain 3 Var 2 to Var 3' -call test_sum_variables_below(did3, VAR2, VAR3, & - exp_sum_range = int(f1v2sz+f1v3sz,i8), & - exp_sum_below1 = int(msize2+f1v1sz,i8), & - exp_sum_below2 = int(msize2+f1v1sz+f1v2sz,i8)) - -write(*,*)' ... Testing Domain 4 Var 1 to Var 3' -call test_sum_variables_below(did4, VAR1, VAR3, & - exp_sum_range = int(f2v1sz+f2v2sz+f2v3sz,i8), & - exp_sum_below1 = int(msize3,i8), & - exp_sum_below2 = int(msize3+f2v1sz+f2v2sz,i8)) - -write(*,*)' ... Testing Domain 5 Var 1 to Var 3' -call test_sum_variables_below(did5, VAR1, VAR3, & - exp_sum_range = int(spv1sz+spv2sz+spv3sz,i8), & - exp_sum_below1 = int(msize4,i8), & - exp_sum_below2 = int(msize4+spv1sz+spv2sz,i8)) - -write(*,*) -write(*,*)'==============================================================' -write(*,*)'Testing state indicies' -write(*,*)'==============================================================' -write(*,*) - -! DOMAIN1 -state_indx = 10_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 10, & - exp_jloc = 1, & - exp_kloc = 1, & - exp_varid = 1, & - exp_domid = dom, & - exp_kind_index = QTY_STATE_VARIABLE, & - exp_kind_string = 'QTY_STATE_VARIABLE') - -! DOMAIN2 -state_indx = 109_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 9, & - exp_jloc = 1, & - exp_kloc = 1, & - exp_varid = 1, & - exp_domid = dom, & - exp_kind_index = QTY_STATE_VARIABLE, & - exp_kind_string = 'QTY_STATE_VARIABLE') - -! DOMAIN3 -state_indx = 112_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 2, & - exp_jloc = 1, & - exp_kloc = 1, & - exp_varid = 1, & - exp_domid = dom, & - exp_kind_index = QTY_STATE_VARIABLE, & - exp_kind_string = 'QTY_STATE_VARIABLE') - -! DOMAIN3 -state_indx = 115_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 2, & - exp_jloc = 1, & - exp_kloc = 1, & - exp_varid = 2, & - exp_domid = dom, & - exp_kind_index = QTY_STATE_VARIABLE, & - exp_kind_string = 'QTY_STATE_VARIABLE') - -! DOMAIN3 -state_indx = 179_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 3, & - exp_jloc = 4, & - exp_kloc = 5, & - exp_varid = 4, & - exp_domid = dom, & - exp_kind_index = QTY_TEMPERATURE, & - exp_kind_string = 'QTY_TEMPERATURE') - -! DOMAIN3 -state_indx = 178_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 2, & - exp_jloc = 4, & - exp_kloc = 5, & - exp_varid = 4, & - exp_domid = dom, & - exp_kind_index = QTY_TEMPERATURE, & - exp_kind_string = 'QTY_TEMPERATURE') - -! DOMAIN4 -state_indx = 179_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 3, & - exp_jloc = 4, & - exp_kloc = 5, & - exp_varid = 4, & - exp_domid = dom, & - exp_kind_index = QTY_TEMPERATURE, & - exp_kind_string = 'QTY_TEMPERATURE') - -! DOMAIN4 -state_indx = 187_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 4, & - exp_jloc = 1, & - exp_kloc = 1, & - exp_varid = 2, & - exp_domid = dom, & - exp_kind_index = QTY_SALINITY, & - exp_kind_string = 'QTY_SALINITY') - -! DOMAIN4 -state_indx = 194_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 3, & - exp_jloc = 2, & - exp_kloc = 1, & - exp_varid = 3, & - exp_domid = dom, & - exp_kind_index = QTY_TEMPERATURE, & - exp_kind_string = 'QTY_TEMPERATURE') - -! DOMAIN4 -state_indx = 307_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 4, & - exp_jloc = 5, & - exp_kloc = 6, & - exp_varid = 3, & - exp_domid = dom, & - exp_kind_index = QTY_TEMPERATURE, & - exp_kind_string = 'QTY_TEMPERATURE') - -! DOMAIN5 -state_indx = 308_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 1, & - exp_jloc = 1, & - exp_kloc = 1, & - exp_varid = 1, & - exp_domid = dom, & - exp_kind_index = QTY_SURFACE_PRESSURE, & - exp_kind_string = 'QTY_SURFACE_PRESSURE') - -! DOMAIN5 -state_indx = 318_i8 -dom = find_domain(state_indx) -write(*,'(A,I5,A,I1)') ' ... Testing state_index ', state_indx, ' Domain ', dom -call test_state_indicies(state_indx, & - exp_iloc = 1, & - exp_jloc = 2, & - exp_kloc = 1, & - exp_varid = 3, & - exp_domid = dom, & - exp_kind_index = QTY_U_WIND_COMPONENT, & - exp_kind_string = 'QTY_U_WIND_COMPONENT') - -write(*,*) -write(*,*)'==============================================================' -write(*,*)'Testing varids from kind' -write(*,*)'==============================================================' -write(*,*) - -write(*,'(2A)')' ... Testing Domain 1 Kind ', trim(get_name_for_quantity(QTY_STATE_VARIABLE)) -call test_varids_from_kind(did1, QTY_STATE_VARIABLE, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/1/) ) - -write(*,'(2A)')' ... Testing Domain 1 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE)) -call test_varids_from_kind(did1, QTY_TEMPERATURE, & - exp_num_varids_from_kind = 0, & - exp_varids_from_kind = (/-1/) ) - -write(*,'(2A)')' ... Testing Domain 2 Kind ', trim(get_name_for_quantity(QTY_STATE_VARIABLE)) -call test_varids_from_kind(did2, QTY_STATE_VARIABLE, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/1/) ) - -write(*,'(2A)')' ... Testing Domain 2 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE)) -call test_varids_from_kind(did2, QTY_TEMPERATURE, & - exp_num_varids_from_kind = 0, & - exp_varids_from_kind = (/-1/) ) - -write(*,'(2A)')' ... Testing Domain 3 Kind ', trim(get_name_for_quantity(QTY_STATE_VARIABLE)) -call test_varids_from_kind(did3, QTY_STATE_VARIABLE, & - exp_num_varids_from_kind = 3, & - exp_varids_from_kind = (/1, 2, 3/) ) - -write(*,'(2A)')' ... Testing Domain 3 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE)) -call test_varids_from_kind(did3, QTY_TEMPERATURE, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/4/) ) - -write(*,'(2A)')' ... Testing Domain 4 Kind ', trim(get_name_for_quantity(QTY_STATE_VARIABLE)) -call test_varids_from_kind(did4, QTY_STATE_VARIABLE, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/1/) ) - -write(*,'(2A)')' ... Testing Domain 4 Kind ', trim(get_name_for_quantity(QTY_SALINITY)) -call test_varids_from_kind(did4, QTY_SALINITY, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/2/) ) - -write(*,'(2A)')' ... Testing Domain 4 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE)) -call test_varids_from_kind(did4, QTY_TEMPERATURE, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/3/) ) - -write(*,'(2A)')' ... Testing Domain 5 Kind ', trim(get_name_for_quantity(QTY_SURFACE_PRESSURE)) -call test_varids_from_kind(did5, QTY_SURFACE_PRESSURE, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/1/) ) - -write(*,'(2A)')' ... Testing Domain 5 Kind ', trim(get_name_for_quantity(QTY_TEMPERATURE)) -call test_varids_from_kind(did5, QTY_TEMPERATURE, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/2/) ) - -write(*,'(2A)')' ... Testing Domain 5 Kind ', trim(get_name_for_quantity(QTY_U_WIND_COMPONENT)) -call test_varids_from_kind(did5, QTY_U_WIND_COMPONENT, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/3/) ) - -write(*,'(2A)')' ... Testing Domain 5 Kind ', trim(get_name_for_quantity(QTY_V_WIND_COMPONENT)) -call test_varids_from_kind(did5, QTY_V_WIND_COMPONENT, & - exp_num_varids_from_kind = 1, & - exp_varids_from_kind = (/4/) ) - -print*, ' ' -! finalize test_state_structure -call error_handler(E_MSG,'test_state_structure',& - 'Finished successfully.',source,revision,revdate) - - -call finalize_utilities() - -! end of main code - -contains - -!---------------------------------------------------------------------- - -subroutine initialize_domains() - - !!!! DOMAIN 1 and DOMAIN 2 !!!! - - ! ! info for blank domain - ! b1sz = 100_i8 - ! b2sz = 10_i8 - - !!!! DOMAIN 3 !!!! - - ! info for domain from file1 - var_names1 = (/'A ', 'B ', 'C ', 'temp'/) - kind_list1 = (/QTY_STATE_VARIABLE, QTY_STATE_VARIABLE, & - QTY_STATE_VARIABLE, QTY_TEMPERATURE/) - ! variable A - clamp_vals1(1,1) = 0.0_r8 - clamp_vals1(1,2) = MISSING_R8 - ! variable B - clamp_vals1(2,1) = MISSING_R8 - clamp_vals1(2,2) = MISSING_R8 - ! variable C - clamp_vals1(3,1) = MISSING_R8 - clamp_vals1(3,2) = 10.0_r8 - ! variable temp - clamp_vals1(4,1) = 1.0_r8 - clamp_vals1(4,2) = 20.0_r8 - - update_list1 = (/.true., .true., .false., .false./) - - !!!! DOMAIN 4 !!!! - - ! info for domain from file2 - var_names2 = (/'B ', 'C ', 'temp'/) - kind_list2 = (/QTY_STATE_VARIABLE, QTY_SALINITY, & - QTY_TEMPERATURE/) - ! variable B - clamp_vals2(1,1) = MISSING_R8 - clamp_vals2(1,2) = MISSING_R8 - ! variable C - clamp_vals2(2,1) = MISSING_R8 - clamp_vals2(2,2) = 10.0_r8 - ! variable temp - clamp_vals2(3,1) = 1.0_r8 - clamp_vals2(3,2) = 20.0_r8 - - update_list2 = (/.true., .true., .false./) - - !!!! DOMAIN 5 !!!! - - ! infor for domain from spec - var_names3 = (/'PS', 'T ', 'U ', 'V '/) - kind_list3 = (/QTY_SURFACE_PRESSURE, QTY_TEMPERATURE, & - QTY_U_WIND_COMPONENT, QTY_V_WIND_COMPONENT/) - ! variable PS - clamp_vals3(1,1) = MISSING_R8 - clamp_vals3(1,2) = MISSING_R8 - ! variable T - clamp_vals3(2,1) = MISSING_R8 - clamp_vals3(2,2) = 10.0_r8 - ! variable U - clamp_vals3(3,1) = MISSING_R8 - clamp_vals3(3,2) = 10.0_r8 - ! variable V - clamp_vals3(4,1) = MISSING_R8 - clamp_vals3(4,2) = 10.0_r8 - - update_list3 = (/.false., .false., .false., .false./) - -end subroutine initialize_domains - -!---------------------------------------------------------------------- - -subroutine fill_domain_structure_for_spec(dom_id) - integer, intent(in) :: dom_id - - integer :: i - do i = 1, get_num_variables(dom_id) - if ( i >= 1) call add_dimension_to_variable(dom_id, i, 'dim1', nsd1) - if ( i >= 2) call add_dimension_to_variable(dom_id, i, 'dim2', nsd2) - if ( i >= 3) call add_dimension_to_variable(dom_id, i, 'dim3', nsd3) - if ( i >= 4) call add_dimension_to_variable(dom_id, i, 'dim4', nsd4) - enddo - - call finished_adding_domain(dom_id) - -end subroutine fill_domain_structure_for_spec - -!---------------------------------------------------------------------- - -subroutine test_sizes_domain(dom_id, exp_dom_size, exp_num_dom_vars, exp_unlim_dimid) - integer, intent(in) :: dom_id - integer, intent(in) :: exp_dom_size - integer, intent(in) :: exp_num_dom_vars - integer, intent(in) :: exp_unlim_dimid - - - string1 = write_message_dom(dom_id, 'get_domain_size') - intVal = get_domain_size(dom_id) - call assert_equal(intVal, exp_dom_size, string1) - - string1 = write_message_dom(dom_id, 'get_num_variables') - intVal = get_num_variables(dom_id) - call assert_equal(intVal, exp_num_dom_vars, string1) - - string1 = write_message_dom(dom_id, 'get_unlimited_dimid') - intVal = get_unlimited_dimid(dom_id) - call assert_equal(intVal, exp_unlim_dimid, string1) - -end subroutine test_sizes_domain - -!---------------------------------------------------------------------- - -subroutine test_variable_info(dom_id, var_id, exp_var_size, exp_num_dims, exp_kind_indx, exp_kind_string, exp_var_name) - integer, intent(in) :: dom_id - integer, intent(in) :: var_id - integer, intent(in) :: exp_var_size - integer, intent(in) :: exp_num_dims - integer, intent(in) :: exp_kind_indx - character(len=*), intent(in) :: exp_kind_string - character(len=*), intent(in) :: exp_var_name - - string1 = write_message_var(dom_id, var_id, 'get_variable_size ') - intVal = get_variable_size(dom_id,var_id) - call assert_equal(intVal, exp_var_size, string1) - - string1 = write_message_var(dom_id, var_id, 'get_variable_name ') - varName = get_variable_name(dom_id,var_id) - call assert_equal(varName, exp_var_name, string1) - - string1 = write_message_var(dom_id, var_id, 'get_num_dims ') - intVal = get_num_dims(dom_id,var_id) - call assert_equal(intVal, exp_num_dims, string1) - - string1 = write_message_var(dom_id, var_id, 'get_kind_string ') - kindString = get_kind_string(dom_id,var_id) - call assert_equal(kindString, exp_kind_string, string1) - - string1 = write_message_var(dom_id, var_id, 'get_kind_index ') - intVal = get_kind_index(dom_id,var_id) - call assert_equal(intVal, exp_kind_indx, string1) - -end subroutine test_variable_info - -!---------------------------------------------------------------------- - -subroutine test_dimension_info(dom_id, var_id, dim_ids, exp_io_numdims, exp_dim_names, exp_dim_lengths, io_dim_ids, exp_io_dim_names, exp_io_dim_lengths, exp_io_dim_ids, exp_io_unique_dim_ids, exp_io_unique_numdims, exp_io_unique_dim_length, exp_io_unique_dim_names) - integer, intent(in) :: dom_id - integer, intent(in) :: var_id - integer, intent(in) :: dim_ids(:) - character(len=*), intent(in) :: exp_dim_names(:) - integer, intent(in) :: exp_dim_lengths(:) - integer, intent(in) :: io_dim_ids(:) - integer, intent(in) :: exp_io_numdims - character(len=*), intent(in) :: exp_io_dim_names(:) - integer, intent(in) :: exp_io_dim_lengths(:) - integer, intent(in) :: exp_io_dim_ids(:) - integer, intent(in) :: exp_io_unique_dim_ids(:) - integer, intent(in) :: exp_io_unique_numdims - integer, intent(in) :: exp_io_unique_dim_length(:) - character(len=*), intent(in) :: exp_io_unique_dim_names(:) - - integer, allocatable :: int_array(:) - integer :: i, num_dims - - ! user interface for dimensions - - num_dims = get_num_dims(dom_id,var_id) - do i = 1,num_dims - string1 = write_message_dim(dom_id, var_id, dim_ids(i), 'get_dim_name ') - varName = get_dim_name(dom_id,var_id,dim_ids(i)) - call assert_equal(varName, exp_dim_names(i), string1) - - string1 = write_message_dim(dom_id, var_id, dim_ids(i), 'get_dim_length ') - intVal = get_dim_length(dom_id,var_id,dim_ids(i)) - call assert_equal(intVal, exp_dim_lengths(i), string1) - - enddo - - allocate( int_array(num_dims) ) - - string1 = write_message_var(dom_id, var_id, 'get_dim_lengths ') - int_array = get_dim_lengths(dom_id,var_id) - call assert_equal(int_array, exp_dim_lengths, string1) - - deallocate( int_array ) - - - string1 = write_message_var(dom_id, var_id, 'get_io_num_dims') - num_dims = get_io_num_dims(dom_id, var_id) - call assert_equal(num_dims, exp_io_numdims, string1) - - allocate( int_array(num_dims) ) - - string1 = write_message_var(dom_id, var_id, 'get_io_dim_lengths ') - int_array = get_io_dim_lengths(dom_id,var_id) - call assert_equal(int_array, exp_io_dim_lengths, string1) - - deallocate( int_array ) - - ! IO interface for dimensions - num_dims = get_io_num_unique_dims(dom_id) - do i = 1,num_dims - string1 = write_message_dim(dom_id, var_id, exp_io_unique_dim_ids(i), 'get_io_unique_dim_name ') - varName = get_io_unique_dim_name(dom_id,exp_io_unique_dim_ids(i)) - call assert_equal(varName, exp_io_unique_dim_names(i), string1) - - string1 = write_message_dim(dom_id, var_id, exp_io_unique_dim_ids(i), 'get_io_unique_dim_lengths ') - intVal = get_io_unique_dim_length(dom_id,exp_io_unique_dim_ids(i)) - call assert_equal(intVal, exp_io_unique_dim_length(i), string1) - - enddo - - allocate( int_array(num_dims) ) - - string1 = write_message_var(dom_id, var_id, 'get_io_dim_ids ') - int_array = get_io_dim_ids(dom_id, var_id) - call assert_equal(int_array, exp_io_dim_ids, string1) - - string1 = write_message_var(dom_id, var_id, 'get_io_num_unique_dims') - intVal = get_io_num_unique_dims(dom_id) - call assert_equal(intVal, exp_io_unique_numdims, string1) - - deallocate( int_array ) - -end subroutine test_dimension_info - -!---------------------------------------------------------------------- - -subroutine test_update_and_clamping(dom_id, var_id, exp_clamp_min, exp_clamp_max, exp_clamping, exp_update) - integer, intent(in) :: dom_id - integer, intent(in) :: var_id - real(r8), intent(in) :: exp_clamp_min - real(r8), intent(in) :: exp_clamp_max - logical, intent(in) :: exp_clamping - logical, intent(in) :: exp_update - - string1 = write_message_var(dom_id, var_id, 'get_io_clamping_minval') - realVal = get_io_clamping_minval(dom_id,var_id) - call assert_equal(realVal, exp_clamp_min, string1) - - string1 = write_message_var(dom_id, var_id, 'get_io_clamping_maxval') - realVal = get_io_clamping_maxval(dom_id,var_id) - call assert_equal(realVal, exp_clamp_max, string1) - - string1 = write_message_var(dom_id, var_id, 'do_io_clamping') - trueFalse = do_io_clamping(dom_id,var_id) - call assert_equal(trueFalse, exp_clamping, string1) - - string1 = write_message_var(dom_id, var_id, 'do_io_update') - trueFalse = do_io_update(dom_id,var_id) - call assert_equal(trueFalse, exp_update, string1) - -end subroutine test_update_and_clamping - -!---------------------------------------------------------------------- - -subroutine test_indices(dom_id, var_id, var_name, exp_start, exp_end) - integer, intent(in) :: dom_id - integer, intent(in) :: var_id - character(len=*), intent(in) :: var_name - integer(i8), intent(in) :: exp_start - integer(i8), intent(in) :: exp_end - - string1 = write_message_var(dom_id, var_id, 'get_index_start_from_varname') - int8val = get_index_start(dom_id,var_name) - call assert_equal(int8val, exp_start, string1) - string1 = write_message_var(dom_id, var_id, 'get_index_start_from_varid') - int8val = get_index_start(dom_id,var_id) - call assert_equal(int8val, exp_start, string1) - - - string1 = write_message_var(dom_id, var_id, 'get_index_end_from_varname') - int8val = get_index_end(dom_id,var_name) - call assert_equal(int8val, exp_end, string1) - - string1 = write_message_var(dom_id, var_id, 'get_index_end_from_varid') - int8val = get_index_end(dom_id,var_id) - call assert_equal(int8val, exp_end, string1) - -end subroutine test_indices - -!---------------------------------------------------------------------- - -subroutine test_sum_variables_below(dom_id, var_id1, var_id2, exp_sum_range, exp_sum_below1, exp_sum_below2) - integer, intent(in) :: dom_id - integer, intent(in) :: var_id1 - integer, intent(in) :: var_id2 - integer(i8), intent(in) :: exp_sum_range - integer(i8), intent(in) :: exp_sum_below1 - integer(i8), intent(in) :: exp_sum_below2 - - string1 = write_message_2var(dom_id, var_id1, var_id2, 'get_sum_variables') - int8Val = get_sum_variables(var_id1,var_id2,dom_id) - call assert_equal(int8Val, exp_sum_range, string1) - - string1 = write_message_var(dom_id, var_id1, 'get_sum_variables_below') - int8Val = get_sum_variables_below(var_id1,dom_id) - call assert_equal(int8Val, exp_sum_below1, string1) - - string1 = write_message_var(dom_id, var_id2, 'get_sum_variables_below') - int8Val = get_sum_variables_below(var_id2,dom_id) - call assert_equal(int8Val, exp_sum_below2, string1) - -end subroutine test_sum_variables_below - -!---------------------------------------------------------------------- - -subroutine test_state_indicies(index_in, exp_iloc, exp_jloc, exp_kloc, exp_varid, exp_domid, exp_kind_index, exp_kind_string) - integer(i8), intent(in) :: index_in - integer, intent(in) :: exp_iloc - integer, intent(in) :: exp_jloc - integer, intent(in) :: exp_kloc - integer, intent(in) :: exp_varid - integer, intent(in) :: exp_domid - integer, intent(in) :: exp_kind_index - character(len=*), intent(in) :: exp_kind_string - - integer :: iloc, jloc, kloc, var_id, dom_id, kind_index - character(len=32) :: kind_string - - call get_model_variable_indices(index_in, iloc, jloc, kloc, var_id, & - dom_id, kind_index, kind_string) - - string1 = write_message_indx(index_in, 'iloc', 'get_model_variable_indices') - call assert_equal(iloc, exp_iloc, string1) - string1 = write_message_indx(index_in, 'jloc', 'get_model_variable_indices') - call assert_equal(jloc, exp_jloc, string1) - string1 = write_message_indx(index_in, 'kloc', 'get_model_variable_indices') - call assert_equal(kloc, exp_kloc, string1) - string1 = write_message_indx(index_in, 'var_id', 'get_model_variable_indices') - call assert_equal(var_id, exp_varid, string1) - string1 = write_message_indx(index_in, 'dom_id', 'get_model_variable_indices') - call assert_equal(dom_id, exp_domid, string1) - string1 = write_message_indx(index_in, 'kind_index', 'get_model_variable_indices') - call assert_equal(kind_index, exp_kind_index, string1) - string1 = write_message_indx(index_in, 'kind_string', 'get_model_variable_indices') - call assert_equal(kind_string,exp_kind_string , string1) - - string1 = write_message_indx(index_in, 'index_out', 'get_dart_vector_index') - int8Val = get_dart_vector_index(iloc, jloc, kloc, dom_id, var_id) - call assert_equal(int8Val, index_in, string1) - -end subroutine test_state_indicies - -!---------------------------------------------------------------------- - -subroutine test_varids_from_kind(dom_id, kind_index, exp_num_varids_from_kind, exp_varids_from_kind) - integer, intent(in) :: dom_id - integer, intent(in) :: kind_index - integer, intent(in) :: exp_num_varids_from_kind - integer, intent(in) :: exp_varids_from_kind(:) - - integer :: size1, nVarIds - integer, allocatable :: int_array(:) - - string1 = write_message_kind(dom_id, kind_index, 'get_num_varids_from_kind') - nVarIds = get_num_varids_from_kind(dom_id, kind_index) - call assert_equal(nVarIds, exp_num_varids_from_kind , string1) - - size1 = size(exp_varids_from_kind,1) - allocate( int_array(size1) ) - - string1 = write_message_kind(dom_id, kind_index, 'get_num_varids_from_kind') - call get_varids_from_kind(dom_id, kind_index, int_array) - call assert_equal(int_array, exp_varids_from_kind, string1) - - if ( nVarIds == 1 ) then ! only works for case when one to one maping of kinds and variables - string1 = write_message_kind(dom_id, kind_index, 'get_varid_from_kind') - intVal = get_varid_from_kind(dom_id, kind_index) - call assert_equal(intVal, exp_varids_from_kind(1), string1) - endif - - deallocate( int_array ) - -end subroutine test_varids_from_kind - -!---------------------------------------------------------------------- - -function find_domain(state_indx) result(dom) - integer(i8), intent(in) :: state_indx - integer :: dom - - integer :: idom - - dom = -1 - do idom = 1, get_num_domains() - if ( state_indx >= msize(idom) .and. & - state_indx <= msize(idom+1) ) then - dom = idom - return - endif - enddo - -end function find_domain - -!---------------------------------------------------------------------- - -function write_message_dom(dom_id, routine) result(msg) - integer, intent(in) :: dom_id - character(len=*), intent(in) :: routine - - character(len=512) :: msg - - write(msg, '(''dom'',I1,'':'', A)') dom_id, trim(routine) - -end function write_message_dom - -!---------------------------------------------------------------------- - -function write_message_2var(dom_id, var_id1, var_id2, routine) result(msg) - integer, intent(in) :: dom_id - integer, intent(in) :: var_id1 - integer, intent(in) :: var_id2 - character(len=*), intent(in) :: routine - - character(len=512) :: msg - - write(msg, '(''dom'',I1,'':var'',I0.2,'':var'',I0.2,'':'',A)') dom_id, var_id1, var_id2, trim(routine) - -end function write_message_2var - -!---------------------------------------------------------------------- - -function write_message_var(dom_id, var_id, routine) result(msg) - integer, intent(in) :: dom_id - integer, intent(in) :: var_id - character(len=*), intent(in) :: routine - - character(len=512) :: msg - - write(msg, '(''dom'',I1,'':var'',I0.2,'':'',A)') dom_id, var_id, trim(routine) - -end function write_message_var - -!---------------------------------------------------------------------- - -function write_message_kind(dom_id, kind_index, routine) result(msg) - integer, intent(in) :: dom_id - integer, intent(in) :: kind_index - character(len=*), intent(in) :: routine - - character(len=512) :: msg - character(len=32) :: kind_string - - kind_string = get_name_for_quantity(kind_index) - - write(msg, '(''dom'',I1,'':kind:'',A,'':'',A)') dom_id, kind_string, trim(routine) - -end function write_message_kind - -!---------------------------------------------------------------------- - -function write_message_dim(dom_id, var_id, dim_id, routine) result(msg) - integer, intent(in) :: dom_id - integer, intent(in) :: var_id - integer, intent(in) :: dim_id - character(len=*), intent(in) :: routine - - character(len=512) :: msg - - write(msg, '(''dom'',I1,'':var'',I0.2'':dim'',I0.2,'':'',A)') dom_id, var_id, dim_id, trim(routine) - -end function write_message_dim - -!---------------------------------------------------------------------- - -function write_message_indx(index_in, test, routine) result(msg) - integer(I8), intent(in) :: index_in - character(len=*), intent(in) :: test - character(len=*), intent(in) :: routine - - character(len=512) :: msg - - write(msg, '(I4,A,'':'',A)') index_in, trim(test), trim(routine) - -end function write_message_indx - -!---------------------------------------------------------------------- - -subroutine initialize_module() - - call initialize_utilities('test_state_structure') - call register_module(source, revision, revdate) - -end subroutine initialize_module - - -end program - -! -! $URL$ -! $Id$ -! $Revision$ -! $Date$ diff --git a/developer_tests/io/work/cf_test.cdl b/developer_tests/io/work/cf_test.cdl deleted file mode 100644 index c9b3c71114..0000000000 --- a/developer_tests/io/work/cf_test.cdl +++ /dev/null @@ -1,49 +0,0 @@ -netcdf cf_out{ - -dimensions: -level = 5; -time = UNLIMITED ; //(1 currently) -variables: - -int A(level); - A:units = "units A"; - A:long_name = "variable A" ; - A:short_name = "short A" ; - A:missing_value = -77 ; - A:_FillValue = -77 ; - -float B(level); - B:units = "units B" ; - B:long_name = "variable B" ; - B:short_name = "short B" ; - B:missing_value = -777.77 ; - B:_FillValue = -777.77 ; - -double C(level); - C:units = "units C" ; - C:long_name = "variable C" ; - C:short_name = "short C" ; - C:missing_value = -88888.88888 ; - C:_FillValue = -88888.88888 ; - -double D(level); - -short E(level); - E:scale_factor = 0.2 ; - E:add_offset = 2.0 ; - -float time(time); - time:units = "hours" ; - -//global attributes: - -:title = "cf restart" ; - -data: -A = 1, 2, 3, 4, 5 ; -B = 1.1, 2.2, 3.3, 4.4, 5.5 ; -C = -10.1, 20.2, 30.3, 40.4, 50.5 ; -D = -100.1, 200.2, 300.3, 400.4, 500.5 ; -E = 1, 2, 3, 4, 5 ; -time = 1 ; -} diff --git a/developer_tests/io/work/input.nml b/developer_tests/io/work/input.nml deleted file mode 100644 index fdfbd5fa30..0000000000 --- a/developer_tests/io/work/input.nml +++ /dev/null @@ -1,68 +0,0 @@ -&utilities_nml - module_details = .false. - write_nml = 'none' - / - -&preprocess_nml - input_obs_kind_mod_file = '../../../assimilation_code/modules/observations/DEFAULT_obs_kind_mod.F90' - output_obs_kind_mod_file = '../../../assimilation_code/modules/observations/obs_kind_mod.f90' - input_obs_def_mod_file = '../../../observations/forward_operators/DEFAULT_obs_def_mod.F90' - output_obs_def_mod_file = '../../../observations/forward_operators/obs_def_mod.f90' - input_files = '../../../observations/forward_operators/obs_def_AIRS_mod.f90', - '../../../observations/forward_operators/obs_def_AOD_mod.f90', - '../../../observations/forward_operators/obs_def_AURA_mod.f90', - '../../../observations/forward_operators/obs_def_COSMOS_mod.f90', - '../../../observations/forward_operators/obs_def_CO_Nadir_mod.f90', - '../../../observations/forward_operators/obs_def_GWD_mod.f90', - '../../../observations/forward_operators/obs_def_QuikSCAT_mod.f90', - '../../../observations/forward_operators/obs_def_SABER_mod.f90', - '../../../observations/forward_operators/obs_def_altimeter_mod.f90', - '../../../observations/forward_operators/obs_def_cloud_mod.f90', - '../../../observations/forward_operators/obs_def_dew_point_mod.f90', - '../../../observations/forward_operators/obs_def_dwl_mod.f90', - '../../../observations/forward_operators/obs_def_eval_mod.f90', - '../../../observations/forward_operators/obs_def_gps_mod.f90', - '../../../observations/forward_operators/obs_def_gts_mod.f90', - '../../../observations/forward_operators/obs_def_land_mod.f90', - '../../../observations/forward_operators/obs_def_metar_mod.f90', - '../../../observations/forward_operators/obs_def_ocean_mod.f90', - '../../../observations/forward_operators/obs_def_pe2lyr_mod.f90', - '../../../observations/forward_operators/obs_def_radar_mod.f90', - '../../../observations/forward_operators/obs_def_reanalysis_bufr_mod.f90', - '../../../observations/forward_operators/obs_def_rel_humidity_mod.f90', - '../../../observations/forward_operators/obs_def_sqg_mod.f90', - '../../../observations/forward_operators/obs_def_tower_mod.f90', - '../../../observations/forward_operators/obs_def_tpw_mod.f90', - '../../../observations/forward_operators/obs_def_upper_atm_mod.f90', - '../../../observations/forward_operators/obs_def_vortex_mod.f90', - '../../../observations/forward_operators/obs_def_wind_speed_mod.f90' - / - -&mpi_utilities_nml -/ - -&obs_kind_nml -/ - -&ensemble_manager_nml -/ - -&state_vector_io_nml -/ - -&test_state_structure_nml - debug = .true. -/ - -&test_read_write_restarts_nml - input_file = 'cf_test.nc' - model_variables = 'A', 'QTY_STATE_VARIABLE', - 'B', 'QTY_U_WIND_COMPONENT', - 'C', 'QTY_V_WIND_COMPONENT', - 'D', 'QTY_SURFACE_PRESSURE' -/ - -&test_read_write_time_nml - input_file = 'time1.nc', 'time2.nc', 'time3.nc', 'time4.nc' -/ - diff --git a/developer_tests/io/work/quickbuild.sh b/developer_tests/io/work/quickbuild.sh deleted file mode 100755 index c60934b756..0000000000 --- a/developer_tests/io/work/quickbuild.sh +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/env bash - -# DART software - Copyright UCAR. This open source software is provided -# by UCAR, "as is", without charge, subject to all terms of use at -# http://www.image.ucar.edu/DAReS/DART/DART_download - -main() { - - -export DART=$(git rev-parse --show-toplevel) -source "$DART"/build_templates/buildfunctions.sh - -MODEL="none" -EXTRA="$DART"/models/template/threed_model_mod.f90 -dev_test=1 -TEST="io" -LOCATION="threed_sphere" - -programs=( -test_cf_conventions -test_diag_structure -test_read_write_restarts -test_read_write_time -test_state_structure -) - - -# quickbuild arguments -arguments "$@" - -# clean the directory -\rm -f -- *.o *.mod Makefile .cppdefs - -# build any NetCDF files from .cdl files -cdl_to_netcdf - -# build and run preprocess before making any other DART executables -buildpreprocess - -# build -buildit - -# clean up -\rm -f -- *.o *.mod - -} - -main "$@" diff --git a/developer_tests/io/work/simple1.cdl b/developer_tests/io/work/simple1.cdl deleted file mode 100644 index 72bf3a1e72..0000000000 --- a/developer_tests/io/work/simple1.cdl +++ /dev/null @@ -1,71 +0,0 @@ -netcdf simple{ - -dimensions: -level = 3; -dump_trucks = 5; -brown_trout = 5; -lat = 4; -lon = 5; -palm_trees = 5; -time = UNLIMITED ; //(1 currently) -variables: - -int A(level); -A:units = "meters"; -A:long_name = "variable A" ; -A:short_name = "short A" ; -A:missing_value = 22 ; - -float B(level); -B:units = "meters/second" ; -B:long_name = "variable B" ; -B:short_name = "short B" ; -B:missing_value = 111.11 ; - -double C(level); -C:units = "meters/kg" ; -C:long_name = "variable C" ; -C:short_name = "short C" ; -C:missing_value = 111.11 ; - -double temp(time,lon,lat,level); -temp:units = "palm trees" ; -temp:long_name = "ambient spectacular temperature from some really great planet and season" ; -temp:short_name = "temperature" ; - -float time(time); -time:units = "hours" ; - -//global attributes: - -:title = "simple_file" ; - -data: -A = 1, 2, 3 ; -B = 1.0, 2.0, 3.0 ; -C = 10.0, 20.0, 30.0; -time = 1 ; - -temp = - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0, - 1.0, 2.0, 3.0; - -} diff --git a/developer_tests/io/work/simple2.cdl b/developer_tests/io/work/simple2.cdl deleted file mode 100644 index 00434cdf31..0000000000 --- a/developer_tests/io/work/simple2.cdl +++ /dev/null @@ -1,68 +0,0 @@ -netcdf simple{ - -dimensions: -level = 4; -lat = 5; -lon = 6; -time = UNLIMITED ; //(1 currently) -variables: - -int A(level); -A:units = "meters"; -A:long_name = "variable A" ; -A:short_name = "short A" ; -A:missing_value = 22 ; - -float B(level); -B:units = "meters/second" ; -B:long_name = "variable B" ; -B:short_name = "short B" ; -B:missing_value = 111.11 ; - -double C(level); -C:units = "meters/kg" ; -C:long_name = "variable C" ; -C:short_name = "short C" ; -C:missing_value = 111.11 ; - -double temp(time,lon,lat,level); -temp:units = "palm trees" ; -temp:long_name = "ambient spectacular temperature from some really great planet and season" ; -temp:short_name = "temperature" ; - -float time(time); -time:units = "hours" ; - -//global attributes: - -:title = "simple_file" ; - -data: -A = 10, 20, 30, 40 ; -B = 10.0, 20.0, 30.0, 40.0; -C = 100.0, 200.0, 300.0, 400.0; -time = 1 ; - -temp = - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, - 10.0, 20.0, 30.0, 40.0, 50.0, 60.0; - -} diff --git a/developer_tests/io/work/time1.cdl b/developer_tests/io/work/time1.cdl deleted file mode 100644 index 24bdfc9808..0000000000 --- a/developer_tests/io/work/time1.cdl +++ /dev/null @@ -1,24 +0,0 @@ -netcdf time1 { - -dimensions: -level = 3; -lat = 4; -lon = 5; - -variables: - -int A(level); -A:units = "meters"; - -float time; -time:units = "days"; - -//global attributes: - -:title = "time1"; - -data: -A = 1, 2, 3 ; -time = 1.5 ; - -} diff --git a/developer_tests/io/work/time2.cdl b/developer_tests/io/work/time2.cdl deleted file mode 100644 index 4b481073ca..0000000000 --- a/developer_tests/io/work/time2.cdl +++ /dev/null @@ -1,25 +0,0 @@ -netcdf time2 { - -dimensions: -level = 3; -lat = 4; -lon = 5; -time = 1; - -variables: - -int A(level); -A:units = "meters"; - -float time(time); -time:units = "days" ; - -//global attributes: - -:title = "time2" ; - -data: -A = 1, 2, 3 ; -time = 2.5 ; - -} diff --git a/developer_tests/io/work/time3.cdl b/developer_tests/io/work/time3.cdl deleted file mode 100644 index 7d74b33fd2..0000000000 --- a/developer_tests/io/work/time3.cdl +++ /dev/null @@ -1,25 +0,0 @@ -netcdf time3 { - -dimensions: -level = 3; -lat = 4; -lon = 5; -time = UNLIMITED; - -variables: - -int A(level); -A:units = "meters"; - -float time(time); -time:units = "days"; - -//global attributes: - -:title = "time3"; - -data: -A = 1, 2, 3 ; -time = 1.5 ; - -} diff --git a/developer_tests/io/work/time4.cdl b/developer_tests/io/work/time4.cdl deleted file mode 100644 index 33a45c23e8..0000000000 --- a/developer_tests/io/work/time4.cdl +++ /dev/null @@ -1,29 +0,0 @@ -netcdf time2 { - -dimensions: -level = 3; -lat = 4; -lon = 5; -time = 1; -copy = UNLIMITED; - -variables: - -int A(level); -A:units = "meters"; - -float time(time); -time:units = "days" ; - -int copy(copy); - -//global attributes: - -:title = "time2" ; - -data: -A = 1, 2, 3 ; -time = 2.5 ; -copy = 1,2,3; - -} From 5e164770d2268c8cc2d8466a0b418eb6cda14d1b Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 6 Dec 2024 10:48:42 -0500 Subject: [PATCH 2/2] bump version and changelog for release --- CHANGELOG.rst | 5 +++++ conf.py | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.rst b/CHANGELOG.rst index 02bc0ddbc6..e47a8f40b3 100644 --- a/CHANGELOG.rst +++ b/CHANGELOG.rst @@ -22,6 +22,11 @@ individual files. The changes are now listed with the most recent at the top. +**December 6 2024 :: Developer tests. Tag v11.8.6** + +- Tests for distribution modules: normal, beta, gamma +- Removed out-of-date tests for state IO + **November 12 2024 :: MPAS bug-fixes. Tag v11.8.5** - Fixed 2m and 10m fields not being updated - set istatus for VERTISHEIGHT diff --git a/conf.py b/conf.py index 8365db092b..cc3ff2fa1d 100644 --- a/conf.py +++ b/conf.py @@ -21,7 +21,7 @@ author = 'Data Assimilation Research Section' # The full version, including alpha/beta/rc tags -release = '11.8.5' +release = '11.8.7' root_doc = 'index' # -- General configuration ---------------------------------------------------