From 112804ca6cbd90d0f5d2ea9145318e699505fcd0 Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Mon, 25 Mar 2019 07:35:33 -0600 Subject: [PATCH] working on general fortran tests --- configure.ac | 19 + tests/general/Makefile.am | 23 +- tests/general/ncdf_fail.F90.in2 | 334 ++ tests/general/ncdf_get_put.F90.in2 | 5652 ++++++++++++++++++ tests/general/ncdf_inq.F90.in2 | 577 ++ tests/general/ncdf_simple_tests.F90.in2 | 950 +++ tests/general/pio_decomp_fillval.F90.in2 | 2709 +++++++++ tests/general/pio_decomp_frame_tests.F90.in2 | 2935 +++++++++ tests/general/pio_decomp_tests.F90.in2 | 2210 +++++++ tests/general/pio_decomp_tests_1d.F90.in2 | 2302 +++++++ tests/general/pio_decomp_tests_2d.F90.in2 | 1537 +++++ tests/general/pio_decomp_tests_3d.F90.in2 | 846 +++ tests/general/pio_file_fail.F90.in2 | 179 + tests/general/pio_file_simple_tests.F90.in2 | 234 + tests/general/pio_init_finalize.F90.in2 | 79 + tests/general/pio_iosystem_tests.F90.in2 | 665 +++ tests/general/pio_iosystem_tests2.F90.in2 | 530 ++ tests/general/pio_iosystem_tests3.F90.in2 | 576 ++ tests/general/pio_rearr.F90.in2 | 623 ++ tests/general/pio_rearr_opts.F90.in2 | 940 +++ tests/general/pio_rearr_opts2.F90.in2 | 822 +++ tests/general/run_tests.sh | 27 + 22 files changed, 24761 insertions(+), 8 deletions(-) create mode 100644 tests/general/ncdf_fail.F90.in2 create mode 100644 tests/general/ncdf_get_put.F90.in2 create mode 100644 tests/general/ncdf_inq.F90.in2 create mode 100644 tests/general/ncdf_simple_tests.F90.in2 create mode 100644 tests/general/pio_decomp_fillval.F90.in2 create mode 100644 tests/general/pio_decomp_frame_tests.F90.in2 create mode 100644 tests/general/pio_decomp_tests.F90.in2 create mode 100644 tests/general/pio_decomp_tests_1d.F90.in2 create mode 100644 tests/general/pio_decomp_tests_2d.F90.in2 create mode 100644 tests/general/pio_decomp_tests_3d.F90.in2 create mode 100644 tests/general/pio_file_fail.F90.in2 create mode 100644 tests/general/pio_file_simple_tests.F90.in2 create mode 100644 tests/general/pio_init_finalize.F90.in2 create mode 100644 tests/general/pio_iosystem_tests.F90.in2 create mode 100644 tests/general/pio_iosystem_tests2.F90.in2 create mode 100644 tests/general/pio_iosystem_tests3.F90.in2 create mode 100644 tests/general/pio_rearr.F90.in2 create mode 100644 tests/general/pio_rearr_opts.F90.in2 create mode 100644 tests/general/pio_rearr_opts2.F90.in2 create mode 100755 tests/general/run_tests.sh diff --git a/configure.ac b/configure.ac index a0dcaaedd8c..e1c13cc61e3 100644 --- a/configure.ac +++ b/configure.ac @@ -126,6 +126,25 @@ AC_CONFIG_FILES(src/flib/piodarray.F90:src/flib/piodarray.F90.in2) AC_CONFIG_FILES(src/flib/pionfatt_mod.F90:src/flib/pionfatt_mod.F90.in2) AC_CONFIG_FILES(src/flib/pionfget_mod.F90:src/flib/pionfget_mod.F90.in2) AC_CONFIG_FILES(src/flib/pionfput_mod.F90:src/flib/pionfput_mod.F90.in2) +AC_CONFIG_FILES(tests/general/ncdf_fail.F90:tests/general/ncdf_fail.F90.in2) +AC_CONFIG_FILES(tests/general/ncdf_get_put.F90:tests/general/ncdf_get_put.F90.in2) +AC_CONFIG_FILES(tests/general/ncdf_inq.F90:tests/general/ncdf_inq.F90.in2) +AC_CONFIG_FILES(tests/general/ncdf_simple_tests.F90:tests/general/ncdf_simple_tests.F90.in2) +AC_CONFIG_FILES(tests/general/pio_decomp_fillval.F90:tests/general/pio_decomp_fillval.F90.in2) +AC_CONFIG_FILES(tests/general/pio_decomp_frame_tests.F90:tests/general/pio_decomp_frame_tests.F90.in2) +AC_CONFIG_FILES(tests/general/pio_decomp_tests_1d.F90:tests/general/pio_decomp_tests_1d.F90.in2) +AC_CONFIG_FILES(tests/general/pio_decomp_tests_2d.F90:tests/general/pio_decomp_tests_2d.F90.in2) +AC_CONFIG_FILES(tests/general/pio_decomp_tests_3d.F90:tests/general/pio_decomp_tests_3d.F90.in2) +AC_CONFIG_FILES(tests/general/pio_decomp_tests.F90:tests/general/pio_decomp_tests.F90.in2) +AC_CONFIG_FILES(tests/general/pio_file_fail.F90:tests/general/pio_file_fail.F90.in2) +AC_CONFIG_FILES(tests/general/pio_file_simple_tests.F90:tests/general/pio_file_simple_tests.F90.in2) +AC_CONFIG_FILES(tests/general/pio_init_finalize.F90:tests/general/pio_init_finalize.F90.in2) +AC_CONFIG_FILES(tests/general/pio_iosystem_tests2.F90:tests/general/pio_iosystem_tests2.F90.in2) +AC_CONFIG_FILES(tests/general/pio_iosystem_tests3.F90:tests/general/pio_iosystem_tests3.F90.in2) +AC_CONFIG_FILES(tests/general/pio_iosystem_tests.F90:tests/general/pio_iosystem_tests.F90.in2) +AC_CONFIG_FILES(tests/general/pio_rearr.F90:tests/general/pio_rearr.F90.in2) +AC_CONFIG_FILES(tests/general/pio_rearr_opts2.F90:tests/general/pio_rearr_opts2.F90.in2) +AC_CONFIG_FILES(tests/general/pio_rearr_opts.F90:tests/general/pio_rearr_opts.F90.in2) # Create the config.h file. AC_CONFIG_HEADERS([config.h]) diff --git a/tests/general/Makefile.am b/tests/general/Makefile.am index 7e486e6c141..6f7f38223aa 100644 --- a/tests/general/Makefile.am +++ b/tests/general/Makefile.am @@ -7,12 +7,11 @@ include $(top_srcdir)/set_flags.am # Build the test for make check. -#check_PROGRAMS = pio_unit_test_driver -# pio_unit_test_driver_SOURCES = driver.F90 -# pio_unit_test_driver_LDADD = libglobal_vars.la libncdf_tests.la \ -# libbasic_tests.la ${top_builddir}/src/flib/libpiof.la ${top_builddir}/src/clib/libpio.la +# check_PROGRAMS = pio_init_finalize +# pio_init_finalize_SOURCES = pio_init_finalize.F90 util/pio_tutil.F90 +# pio_init_finalize_LDADD = ${top_builddir}/src/flib/libpiof.la ${top_builddir}/src/clib/libpio.la -# # Build these uninstalled convenience libraries. +# Build these uninstalled convenience libraries. # noinst_LTLIBRARIES = libglobal_vars.la libncdf_tests.la \ # libbasic_tests.la @@ -21,11 +20,19 @@ include $(top_srcdir)/set_flags.am # libncdf_tests_la_SOURCES = ncdf_tests.F90 # libbasic_tests_la_SOURCES = basic_tests.F90 -# # Tests will run from a bash script. -# #TESTS = run_tests.sh +# Tests will run from a bash script. +#TESTS = run_tests.sh # Distribute the test script. -EXTRA_DIST = CMakeLists.txt #run_tests.sh +EXTRA_DIST = CMakeLists.txt run_tests.sh ncdf_fail.F90.in2 \ +ncdf_get_put.F90.in2 ncdf_inq.F90.in2 ncdf_simple_tests.F90.in2 \ +pio_decomp_fillval.F90.in2 pio_decomp_frame_tests.F90.in2 \ +pio_decomp_tests_1d.F90.in2 pio_decomp_tests_2d.F90.in2 \ +pio_decomp_tests_3d.F90.in2 pio_decomp_tests.F90.in2 \ +pio_file_fail.F90.in2 pio_file_simple_tests.F90.in2 \ +pio_init_finalize.F90.in2 pio_iosystem_tests2.F90.in2 \ +pio_iosystem_tests3.F90.in2 pio_iosystem_tests.F90.in2 \ +pio_rearr.F90.in2 pio_rearr_opts2.F90.in2 pio_rearr_opts.F90.in2 # Clean up files produced during testing. CLEANFILES = *.nc *.log diff --git a/tests/general/ncdf_fail.F90.in2 b/tests/general/ncdf_fail.F90.in2 new file mode 100644 index 00000000000..d6990cfc98c --- /dev/null +++ b/tests/general/ncdf_fail.F90.in2 @@ -0,0 +1,334 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/ncdf_fail.F90.in + +MODULE ncdf_fail_tgv ! ncdf_fail.F90.in:1 + use pio_tutil ! ncdf_fail.F90.in:2 + implicit none ! ncdf_fail.F90.in:3 + + + ! tgv = test global vars + character(len=PIO_TF_MAX_STR_LEN), parameter :: tgv_fname = "pio_ncdf_test_file.nc" ! ncdf_fail.F90.in:6 + integer :: tgv_iotype ! ncdf_fail.F90.in:7 +END MODULE ncdf_fail_tgv ! ncdf_fail.F90.in:8 + + +SUBROUTINE test_clob_then_no_clob + USE pio_tutil + ! ncdf_fail.F90.in:10 + use ncdf_fail_tgv ! ncdf_fail.F90.in:11 + Implicit none ! ncdf_fail.F90.in:12 + type(file_desc_t) :: pio_file ! ncdf_fail.F90.in:13 + character(len=PIO_TF_MAX_STR_LEN), parameter :: clob_fname = "pio_clob_test_file.nc" ! ncdf_fail.F90.in:14 + integer :: ret ! ncdf_fail.F90.in:15 + + + ret = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, clob_fname, PIO_CLOBBER) ! ncdf_fail.F90.in:17 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create:" // trim(clob_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:18)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:18 + + + call PIO_closefile(pio_file) ! ncdf_fail.F90.in:20 + + + ret = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, clob_fname, PIO_NOCLOBBER) ! ncdf_fail.F90.in:22 + + IF (.NOT. (PIO_TF_Passert_(ret /= PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Create file with clobber then no clobber did not fail as expected",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:23)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:23 + + + ! No close since createfile should fail + call PIO_deletefile(pio_tf_iosystem_, clob_fname) ! ncdf_fail.F90.in:26 + + +END SUBROUTINE test_clob_then_no_clob ! ncdf_fail.F90.in:28 + + +SUBROUTINE test_redef_with_no_write + USE pio_tutil + ! ncdf_fail.F90.in:30 + use ncdf_fail_tgv ! ncdf_fail.F90.in:31 + Implicit none ! ncdf_fail.F90.in:32 + type(file_desc_t) :: pio_file ! ncdf_fail.F90.in:33 + integer :: ret ! ncdf_fail.F90.in:34 + + + ret = PIO_openfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname, PIO_nowrite) ! ncdf_fail.F90.in:36 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:37)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:37 + + + ! A simple redef and then enddef + ret = PIO_redef(pio_file) ! ncdf_fail.F90.in:40 + + IF (.NOT. (PIO_TF_Passert_(ret /= PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Redef with nowrite did not fail as expected",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:41)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:41 + + + ! No enddef because redef is expected to fail + call PIO_closefile(pio_file) ! ncdf_fail.F90.in:44 + + +END SUBROUTINE test_redef_with_no_write ! ncdf_fail.F90.in:46 + + +SUBROUTINE test_redef_twice + USE pio_tutil + ! ncdf_fail.F90.in:48 + use ncdf_fail_tgv ! ncdf_fail.F90.in:49 + Implicit none ! ncdf_fail.F90.in:50 + type(file_desc_t) :: pio_file ! ncdf_fail.F90.in:51 + integer :: ret ! ncdf_fail.F90.in:52 + + + ret = PIO_openfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname, PIO_write) ! ncdf_fail.F90.in:54 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:55)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:55 + + + ! A simple redef and then enddef + ret = PIO_redef(pio_file) ! ncdf_fail.F90.in:58 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enter redef mode" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:59)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:59 + + + ret = PIO_redef(pio_file) ! ncdf_fail.F90.in:61 + + IF (.NOT. (PIO_TF_Passert_(ret /= PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Entering redef twice did not fail as expected",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:62)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:62 + + + ret = PIO_enddef(pio_file) ! ncdf_fail.F90.in:64 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:65)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:65 + + + call PIO_closefile(pio_file) ! ncdf_fail.F90.in:67 + + +END SUBROUTINE test_redef_twice ! ncdf_fail.F90.in:69 + + +SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + ! ncdf_fail.F90.in:71 + use ncdf_fail_tgv ! ncdf_fail.F90.in:72 + Implicit none ! ncdf_fail.F90.in:73 + type(file_desc_t) :: pio_file ! ncdf_fail.F90.in:74 + integer :: ret, i ! ncdf_fail.F90.in:75 + ! iotypes = valid NC types + integer, dimension(:), allocatable :: iotypes ! ncdf_fail.F90.in:77 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! ncdf_fail.F90.in:78 + integer :: num_iotypes ! ncdf_fail.F90.in:79 + + + num_iotypes = 0 ! ncdf_fail.F90.in:81 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! ncdf_fail.F90.in:82 + do i=1,num_iotypes ! ncdf_fail.F90.in:83 + tgv_iotype = iotypes(i) ! ncdf_fail.F90.in:84 + ret = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname) ! ncdf_fail.F90.in:85 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create:"//trim(iotype_descs(i))//":"//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_fail.F90.in:87)" + END IF + RETURN + END IF ! ncdf_fail.F90.in:87 + + + call PIO_closefile(pio_file) ! ncdf_fail.F90.in:89 + + + ! Make sure that global variables are set correctly before running the tests + + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Running AUTO tests: ", trim(iotype_descs(i)) + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_clob_then_no_clob"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_clob_then_no_clob" + END IF + CALL test_clob_then_no_clob() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_redef_with_no_write"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_redef_with_no_write" + END IF + CALL test_redef_with_no_write() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_redef_twice"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_redef_twice" + END IF + CALL test_redef_twice() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + ! ncdf_fail.F90.in:92 + + + call PIO_deletefile(pio_tf_iosystem_, tgv_fname) ! ncdf_fail.F90.in:94 + end do ! ncdf_fail.F90.in:95 + if(allocated(iotypes)) then ! ncdf_fail.F90.in:96 + deallocate(iotypes) ! ncdf_fail.F90.in:97 + deallocate(iotype_descs) ! ncdf_fail.F90.in:98 + end if ! ncdf_fail.F90.in:99 + + + +END SUBROUTINE PIO_TF_Test_driver_ ! ncdf_fail.F90.in:101 + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/ncdf_get_put.F90.in2 b/tests/general/ncdf_get_put.F90.in2 new file mode 100644 index 00000000000..f1267c61264 --- /dev/null +++ b/tests/general/ncdf_get_put.F90.in2 @@ -0,0 +1,5652 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/ncdf_get_put.F90.in + + + +SUBROUTINE test_put_1datt_PIO_int_integer__ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + integer, dimension(DIM_LEN) :: val + CHARACTER(len=DIM_LEN) :: cval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + val = pio_tf_world_sz_ + cval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:24)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:25 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:28)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:29 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:31)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:32 + ret = PIO_def_var(pio_file, 'dummy_var_put_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:34)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:35 + ret = PIO_put_att(pio_file, pio_var, 'dummy_att_put_val', val); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:37)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:38 + ret = PIO_put_att(pio_file, pio_cvar, 'dummy_att_put_cval', cval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:40)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:41 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:43)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:44 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:52 +END SUBROUTINE test_put_1datt_PIO_int_integer__ + + +SUBROUTINE test_put_1datt_PIO_real_real_kind_fc_real___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + real(kind=fc_real), dimension(DIM_LEN) :: val + CHARACTER(len=DIM_LEN) :: cval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + val = pio_tf_world_sz_ + cval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:24)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:25 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:28)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:29 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:31)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:32 + ret = PIO_def_var(pio_file, 'dummy_var_put_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:34)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:35 + ret = PIO_put_att(pio_file, pio_var, 'dummy_att_put_val', val); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:37)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:38 + ret = PIO_put_att(pio_file, pio_cvar, 'dummy_att_put_cval', cval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:40)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:41 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:43)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:44 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:52 +END SUBROUTINE test_put_1datt_PIO_real_real_kind_fc_real___ + + +SUBROUTINE test_put_1datt_PIO_double_real_kind_fc_double___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + real(kind=fc_double), dimension(DIM_LEN) :: val + CHARACTER(len=DIM_LEN) :: cval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + val = pio_tf_world_sz_ + cval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:24)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:25 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:28)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:29 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:31)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:32 + ret = PIO_def_var(pio_file, 'dummy_var_put_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:34)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:35 + ret = PIO_put_att(pio_file, pio_var, 'dummy_att_put_val', val); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:37)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:38 + ret = PIO_put_att(pio_file, pio_cvar, 'dummy_att_put_cval', cval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:40)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:41 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:43)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:44 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:52 +END SUBROUTINE test_put_1datt_PIO_double_real_kind_fc_double___ + ! ncdf_get_put.F90.in:53 + + + + +SUBROUTINE test_put_get_1datt_PIO_int_integer__ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + integer, dimension(DIM_LEN) :: pval, gval + integer :: init_val + CHARACTER(len=DIM_LEN) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + init_val = pio_tf_world_sz_ + ! ncdf_get_put.F90.in:72 + pval = init_val + pcval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:81)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:82 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:85)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:86 + ret = PIO_def_var(pio_file, 'dummy_val', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:88)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:89 + ret = PIO_def_var(pio_file, 'dummy_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:91)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:92 + ret = PIO_put_att(pio_file, pio_var, 'dummy_att_val', pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:94)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:95 + ret = PIO_put_att(pio_file, pio_cvar, 'dummy_att_cval', pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:97)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:98 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:100)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:101 + ret = PIO_get_att(pio_file, pio_var, 'dummy_att_val', gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:103)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:104 + + IF (.NOT. PIO_TF_Check_val_(gval, init_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:105)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:106 + ! FIXME: Check the values are correct + ret = PIO_get_att(pio_file, pio_cvar, 'dummy_att_cval', gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:109)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:110 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:118 +END SUBROUTINE test_put_get_1datt_PIO_int_integer__ + + +SUBROUTINE test_put_get_1datt_PIO_real_real_kind_fc_real___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + real(kind=fc_real), dimension(DIM_LEN) :: pval, gval + real(kind=fc_real) :: init_val + CHARACTER(len=DIM_LEN) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + init_val = pio_tf_world_sz_ + ! ncdf_get_put.F90.in:72 + pval = init_val + pcval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:81)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:82 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:85)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:86 + ret = PIO_def_var(pio_file, 'dummy_val', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:88)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:89 + ret = PIO_def_var(pio_file, 'dummy_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:91)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:92 + ret = PIO_put_att(pio_file, pio_var, 'dummy_att_val', pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:94)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:95 + ret = PIO_put_att(pio_file, pio_cvar, 'dummy_att_cval', pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:97)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:98 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:100)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:101 + ret = PIO_get_att(pio_file, pio_var, 'dummy_att_val', gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:103)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:104 + + IF (.NOT. PIO_TF_Check_val_(gval, init_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:105)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:106 + ! FIXME: Check the values are correct + ret = PIO_get_att(pio_file, pio_cvar, 'dummy_att_cval', gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:109)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:110 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:118 +END SUBROUTINE test_put_get_1datt_PIO_real_real_kind_fc_real___ + + +SUBROUTINE test_put_get_1datt_PIO_double_real_kind_fc_double___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + real(kind=fc_double), dimension(DIM_LEN) :: pval, gval + real(kind=fc_double) :: init_val + CHARACTER(len=DIM_LEN) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + init_val = pio_tf_world_sz_ + ! ncdf_get_put.F90.in:72 + pval = init_val + pcval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:81)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:82 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:85)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:86 + ret = PIO_def_var(pio_file, 'dummy_val', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:88)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:89 + ret = PIO_def_var(pio_file, 'dummy_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:91)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:92 + ret = PIO_put_att(pio_file, pio_var, 'dummy_att_val', pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:94)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:95 + ret = PIO_put_att(pio_file, pio_cvar, 'dummy_att_cval', pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:97)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:98 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:100)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:101 + ret = PIO_get_att(pio_file, pio_var, 'dummy_att_val', gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:103)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:104 + + IF (.NOT. PIO_TF_Check_val_(gval, init_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:105)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:106 + ! FIXME: Check the values are correct + ret = PIO_get_att(pio_file, pio_cvar, 'dummy_att_cval', gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get attribute:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:109)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:110 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:118 +END SUBROUTINE test_put_get_1datt_PIO_double_real_kind_fc_double___ + ! ncdf_get_put.F90.in:119 + + + + +SUBROUTINE test_put_get_0dvar_PIO_int_integer__ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer, dimension(1) :: pval, gval + CHARACTER(len=1) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = pio_tf_world_sz_ + pcval = "D" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:142)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:143 + ! Since file is just created no need to enter redef + ret = PIO_def_var(pio_file, 'dummy_scalar_var_put_val', PIO_int, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:146)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:147 + ret = PIO_def_var(pio_file, 'dummy_scalar_var_put_cval', PIO_char, pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:149)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:150 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:152)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:153 + ret = PIO_put_var(pio_file, pio_var, pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:155)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:156 + ret = PIO_put_var(pio_file, pio_cvar, pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:158)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:159 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:161 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:163)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:164 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:165)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:166 + ret = PIO_get_var(pio_file, pio_cvar, gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:168)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:169 + + IF (.NOT. PIO_TF_Check_val_(gcval, pcval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:170)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:171 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:179 +END SUBROUTINE test_put_get_0dvar_PIO_int_integer__ + + +SUBROUTINE test_put_get_0dvar_PIO_real_real_kind_fc_real___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + real(kind=fc_real), dimension(1) :: pval, gval + CHARACTER(len=1) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = pio_tf_world_sz_ + pcval = "D" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:142)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:143 + ! Since file is just created no need to enter redef + ret = PIO_def_var(pio_file, 'dummy_scalar_var_put_val', PIO_real, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:146)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:147 + ret = PIO_def_var(pio_file, 'dummy_scalar_var_put_cval', PIO_char, pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:149)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:150 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:152)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:153 + ret = PIO_put_var(pio_file, pio_var, pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:155)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:156 + ret = PIO_put_var(pio_file, pio_cvar, pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:158)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:159 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:161 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:163)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:164 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:165)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:166 + ret = PIO_get_var(pio_file, pio_cvar, gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:168)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:169 + + IF (.NOT. PIO_TF_Check_val_(gcval, pcval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:170)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:171 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:179 +END SUBROUTINE test_put_get_0dvar_PIO_real_real_kind_fc_real___ + + +SUBROUTINE test_put_get_0dvar_PIO_double_real_kind_fc_double___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + real(kind=fc_double), dimension(1) :: pval, gval + CHARACTER(len=1) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = pio_tf_world_sz_ + pcval = "D" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:142)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:143 + ! Since file is just created no need to enter redef + ret = PIO_def_var(pio_file, 'dummy_scalar_var_put_val', PIO_double, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:146)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:147 + ret = PIO_def_var(pio_file, 'dummy_scalar_var_put_cval', PIO_char, pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:149)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:150 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:152)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:153 + ret = PIO_put_var(pio_file, pio_var, pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:155)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:156 + ret = PIO_put_var(pio_file, pio_cvar, pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:158)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:159 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:161 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get scalar var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:163)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:164 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:165)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:166 + ret = PIO_get_var(pio_file, pio_cvar, gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get scalar char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:168)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:169 + + IF (.NOT. PIO_TF_Check_val_(gcval, pcval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:170)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:171 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:179 +END SUBROUTINE test_put_get_0dvar_PIO_double_real_kind_fc_double___ + ! ncdf_get_put.F90.in:180 + + + + +SUBROUTINE test_put_get_1dvar_PIO_int_integer__ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + integer, dimension(DIM_LEN) :: pval, gval + CHARACTER(len=DIM_LEN) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = pio_tf_world_sz_ + pcval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:205)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:206 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:209)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:210 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:212)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:213 + ret = PIO_def_var(pio_file, 'dummy_var_put_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:215)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:216 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:218)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:219 + ret = PIO_put_var(pio_file, pio_var, pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:221)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:222 + ret = PIO_put_var(pio_file, pio_cvar, pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:224)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:225 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:227 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:229)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:230 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:231)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:232 + ret = PIO_get_var(pio_file, pio_cvar, gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:234)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:235 + + IF (.NOT. PIO_TF_Check_val_(gcval, pcval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:236)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:237 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:245 +END SUBROUTINE test_put_get_1dvar_PIO_int_integer__ + + +SUBROUTINE test_put_get_1dvar_PIO_real_real_kind_fc_real___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + real(kind=fc_real), dimension(DIM_LEN) :: pval, gval + CHARACTER(len=DIM_LEN) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = pio_tf_world_sz_ + pcval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:205)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:206 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:209)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:210 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:212)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:213 + ret = PIO_def_var(pio_file, 'dummy_var_put_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:215)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:216 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:218)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:219 + ret = PIO_put_var(pio_file, pio_var, pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:221)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:222 + ret = PIO_put_var(pio_file, pio_cvar, pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:224)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:225 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:227 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:229)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:230 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:231)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:232 + ret = PIO_get_var(pio_file, pio_cvar, gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:234)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:235 + + IF (.NOT. PIO_TF_Check_val_(gcval, pcval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:236)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:237 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:245 +END SUBROUTINE test_put_get_1dvar_PIO_real_real_kind_fc_real___ + + +SUBROUTINE test_put_get_1dvar_PIO_double_real_kind_fc_double___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 100 + real(kind=fc_double), dimension(DIM_LEN) :: pval, gval + CHARACTER(len=DIM_LEN) :: pcval, gcval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = pio_tf_world_sz_ + pcval = "DUMMY_STRING" + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:205)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:206 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:209)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:210 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:212)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:213 + ret = PIO_def_var(pio_file, 'dummy_var_put_cval', PIO_char, (/pio_dim/), pio_cvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:215)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:216 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:218)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:219 + ret = PIO_put_var(pio_file, pio_var, pval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:221)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:222 + ret = PIO_put_var(pio_file, pio_cvar, pcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:224)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:225 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:227 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:229)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:230 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:231)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:232 + ret = PIO_get_var(pio_file, pio_cvar, gcval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get char var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:234)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:235 + + IF (.NOT. PIO_TF_Check_val_(gcval, pcval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:236)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:237 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:245 +END SUBROUTINE test_put_get_1dvar_PIO_double_real_kind_fc_double___ + ! ncdf_get_put.F90.in:246 + + +! Write out a 1d var slice from a 2d var + + +SUBROUTINE test_put_get_1dvar_slice_PIO_int_integer__ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: MAX_ROW_DIM_LEN = 100 + integer, dimension(MAX_ROW_DIM_LEN) :: gval, exp_val + integer, parameter :: MAX_COL_DIM_LEN = 4 + ! Only COL_WRITE_DIM of MAX_COL_DIM_LEN columns in pval is written out + integer, parameter :: COL_WRITE_DIM = 2 + integer, dimension(MAX_ROW_DIM_LEN, MAX_COL_DIM_LEN) :: pval + integer, dimension(:) :: start(4), count(4) + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = -1 + pval(:,COL_WRITE_DIM) = pio_tf_world_sz_ + exp_val = pio_tf_world_sz_ + start = 0 + count = 0 + start(1) = 1 + count(1) = MAX_ROW_DIM_LEN + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put_slice.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:281)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:282 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', MAX_ROW_DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:285)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:286 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:288)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:289 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:291)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:292 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(:,COL_WRITE_DIM)); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:294)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:295 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:297 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:299)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:300 + + IF (.NOT. PIO_TF_Check_val_(gval, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:301)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:302 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:310 +END SUBROUTINE test_put_get_1dvar_slice_PIO_int_integer__ + + +SUBROUTINE test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: MAX_ROW_DIM_LEN = 100 + real(kind=fc_real), dimension(MAX_ROW_DIM_LEN) :: gval, exp_val + integer, parameter :: MAX_COL_DIM_LEN = 4 + ! Only COL_WRITE_DIM of MAX_COL_DIM_LEN columns in pval is written out + integer, parameter :: COL_WRITE_DIM = 2 + real(kind=fc_real), dimension(MAX_ROW_DIM_LEN, MAX_COL_DIM_LEN) :: pval + integer, dimension(:) :: start(4), count(4) + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = -1 + pval(:,COL_WRITE_DIM) = pio_tf_world_sz_ + exp_val = pio_tf_world_sz_ + start = 0 + count = 0 + start(1) = 1 + count(1) = MAX_ROW_DIM_LEN + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put_slice.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:281)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:282 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', MAX_ROW_DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:285)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:286 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:288)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:289 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:291)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:292 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(:,COL_WRITE_DIM)); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:294)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:295 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:297 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:299)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:300 + + IF (.NOT. PIO_TF_Check_val_(gval, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:301)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:302 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:310 +END SUBROUTINE test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___ + + +SUBROUTINE test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: MAX_ROW_DIM_LEN = 100 + real(kind=fc_double), dimension(MAX_ROW_DIM_LEN) :: gval, exp_val + integer, parameter :: MAX_COL_DIM_LEN = 4 + ! Only COL_WRITE_DIM of MAX_COL_DIM_LEN columns in pval is written out + integer, parameter :: COL_WRITE_DIM = 2 + real(kind=fc_double), dimension(MAX_ROW_DIM_LEN, MAX_COL_DIM_LEN) :: pval + integer, dimension(:) :: start(4), count(4) + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + + pval = -1 + pval(:,COL_WRITE_DIM) = pio_tf_world_sz_ + exp_val = pio_tf_world_sz_ + start = 0 + count = 0 + start(1) = 1 + count(1) = MAX_ROW_DIM_LEN + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put_slice.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:281)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:282 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', MAX_ROW_DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:285)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:286 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:288)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:289 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:291)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:292 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(:,COL_WRITE_DIM)); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:294)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:295 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:297 + ret = PIO_get_var(pio_file, pio_var, gval); + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:299)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:300 + + IF (.NOT. PIO_TF_Check_val_(gval, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:301)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:302 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:310 +END SUBROUTINE test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___ + ! ncdf_get_put.F90.in:311 + + + + +SUBROUTINE test_put_get_1dvar_4parts_PIO_int_integer__ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 16 + integer, parameter :: PART_LEN = DIM_LEN / 4 + integer, dimension(DIM_LEN) :: pval, gval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + integer, dimension(1) :: start, count = PART_LEN + + do i=1,DIM_LEN + pval(i) = i + end do + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:338)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:339 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:342)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:343 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:345)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:346 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:348)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:349 + start = 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(1 : PART_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (1st part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:352)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:353 + start = PART_LEN + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN + 1 : PART_LEN * 2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (2nd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:356)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:357 + start = PART_LEN * 2 + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN * 2 + 1 : PART_LEN * 3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (3rd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:360)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:361 + start = PART_LEN * 3 + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN * 3 + 1 : DIM_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (4th part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:364)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:365 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:367 + start = PART_LEN * 3 + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN * 3 + 1 : DIM_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (4th part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:370)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:371 + start = PART_LEN * 2 + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN * 2 + 1 : PART_LEN * 3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (3rd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:374)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:375 + start = PART_LEN + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN + 1 : PART_LEN * 2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (2nd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:378)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:379 + start = 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(1 : PART_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (1st part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:382)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:383 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:384)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:385 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:393 +END SUBROUTINE test_put_get_1dvar_4parts_PIO_int_integer__ + + +SUBROUTINE test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 16 + integer, parameter :: PART_LEN = DIM_LEN / 4 + real(kind=fc_real), dimension(DIM_LEN) :: pval, gval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + integer, dimension(1) :: start, count = PART_LEN + + do i=1,DIM_LEN + pval(i) = i + end do + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:338)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:339 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:342)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:343 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:345)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:346 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:348)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:349 + start = 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(1 : PART_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (1st part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:352)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:353 + start = PART_LEN + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN + 1 : PART_LEN * 2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (2nd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:356)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:357 + start = PART_LEN * 2 + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN * 2 + 1 : PART_LEN * 3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (3rd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:360)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:361 + start = PART_LEN * 3 + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN * 3 + 1 : DIM_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (4th part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:364)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:365 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:367 + start = PART_LEN * 3 + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN * 3 + 1 : DIM_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (4th part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:370)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:371 + start = PART_LEN * 2 + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN * 2 + 1 : PART_LEN * 3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (3rd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:374)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:375 + start = PART_LEN + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN + 1 : PART_LEN * 2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (2nd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:378)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:379 + start = 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(1 : PART_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (1st part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:382)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:383 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:384)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:385 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:393 +END SUBROUTINE test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___ + + +SUBROUTINE test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(var_desc_t) :: pio_var, pio_cvar + integer :: pio_dim + integer, parameter :: DIM_LEN = 16 + integer, parameter :: PART_LEN = DIM_LEN / 4 + real(kind=fc_double), dimension(DIM_LEN) :: pval, gval + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, ret + integer, dimension(1) :: start, count = PART_LEN + + do i=1,DIM_LEN + pval(i) = i + end do + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:338)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:339 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'dummy_dim_put_val', DIM_LEN, pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:342)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:343 + ret = PIO_def_var(pio_file, 'dummy_var_put_val', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:345)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:346 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:348)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:349 + start = 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(1 : PART_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (1st part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:352)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:353 + start = PART_LEN + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN + 1 : PART_LEN * 2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (2nd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:356)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:357 + start = PART_LEN * 2 + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN * 2 + 1 : PART_LEN * 3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (3rd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:360)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:361 + start = PART_LEN * 3 + 1 + ret = PIO_put_var(pio_file, pio_var, start, count, pval(PART_LEN * 3 + 1 : DIM_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var (4th part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:364)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:365 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:367 + start = PART_LEN * 3 + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN * 3 + 1 : DIM_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (4th part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:370)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:371 + start = PART_LEN * 2 + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN * 2 + 1 : PART_LEN * 3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (3rd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:374)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:375 + start = PART_LEN + 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(PART_LEN + 1 : PART_LEN * 2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (2nd part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:378)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:379 + start = 1 + ret = PIO_get_var(pio_file, pio_var, start, count, gval(1 : PART_LEN)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get var (1st part):" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:382)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:383 + + IF (.NOT. PIO_TF_Check_val_(gval, pval)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:384)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:385 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:393 +END SUBROUTINE test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___ + ! ncdf_get_put.F90.in:394 + + +! Write out 2d/3d/4d vars, one time slice at a time + + +SUBROUTINE test_put_get_md2mdplus1_var_PIO_int_integer__ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + integer, parameter :: MAX_DIMS = 4 + integer, parameter :: MAX_ROWS = 10 + integer, parameter :: MAX_COLS = 10 + integer, parameter :: MAX_LEVS = 3 + integer, parameter :: MAX_TIMES = 3 + integer, dimension(MAX_DIMS) :: pio_dims + type(var_desc_t) :: pio_2dvar, pio_3dvar, pio_4dvar + integer, dimension(MAX_ROWS,MAX_TIMES) :: gval_2d, exp_val_2d + integer, dimension(MAX_ROWS,MAX_COLS,MAX_TIMES) :: gval_3d, exp_val_3d + integer, dimension(MAX_ROWS,MAX_COLS,MAX_LEVS,MAX_TIMES) ::& + gval_4d, exp_val_4d + ! Only one slice is written out at a time + ! pval_1d is a 1d slice of gval_2d ... + integer, dimension(MAX_ROWS) :: pval_1d + integer, dimension(MAX_ROWS, MAX_COLS) :: pval_2d + integer, dimension(MAX_ROWS, MAX_COLS, MAX_LEVS) :: pval_3d + integer, dimension(:) :: start(MAX_DIMS), count(MAX_DIMS) + integer :: pval_start + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, k, l, m, n, tstep, ret + + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put_md_slice.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:431)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:432 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'nrows', MAX_ROWS, pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:435)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:436 + ret = PIO_def_dim(pio_file, 'ncols', MAX_COLS, pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:438)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:439 + ret = PIO_def_dim(pio_file, 'nlevs', MAX_LEVS, pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:441)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:442 + ret = PIO_def_dim(pio_file, 'timesteps', MAX_TIMES, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:444)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:445 + ret = PIO_def_var(pio_file, '2d_val', PIO_int,& + (/pio_dims(1),pio_dims(4)/), pio_2dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:448)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:449 + ret = PIO_def_var(pio_file, '3d_val', PIO_int,& + (/pio_dims(1),pio_dims(2),pio_dims(4)/), pio_3dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:452)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:453 + ret = PIO_def_var(pio_file, '4d_val', PIO_int,& + pio_dims, pio_4dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:456)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:457 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:459)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:460 + ! Put vals are for each timestep & + ! expected vals are combined for all timesteps + do k=1,MAX_ROWS + pval_1d(k) = k + end do + do tstep=1,MAX_TIMES + pval_start = (tstep - 1) * MAX_ROWS + exp_val_2d(:,tstep) = pval_1d + pval_start + end do + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_2d(k,l) = (l - 1)*MAX_ROWS + k + end do + end do + do tstep=1,MAX_TIMES + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS) + exp_val_3d(:,:,tstep) = pval_2d + pval_start + end do + end do + end do + do m=1,MAX_LEVS + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_3d(k,l,m) = ((m-1)*(MAX_COLS*MAX_ROWS)+(l - 1)*MAX_ROWS + k) + end do + end do + end do + do tstep=1,MAX_TIMES + do m=1,MAX_LEVS + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS * MAX_LEVS) + exp_val_4d(:,:,:,tstep) = pval_3d + pval_start + end do + end do + end do + end do + ! Put 2d/3d/4d vals, one timestep at a time + do tstep=1,MAX_TIMES + start = 0 + count = 0 + ! ncdf_get_put.F90.in:504 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = tstep + count(2) = 1 + pval_start = (tstep - 1) * MAX_ROWS + ret = PIO_put_var(pio_file, pio_2dvar, start, count,& + pval_1d(:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 2d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:512)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:513 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = 1 + count(2) = MAX_COLS + start(3) = tstep + count(3) = 1 + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS) + ret = PIO_put_var(pio_file, pio_3dvar, start, count,& + pval_2d(:,:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 3d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:523)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:524 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = 1 + count(2) = MAX_COLS + start(3) = 1 + count(3) = MAX_LEVS + start(4) = tstep + count(4) = 1 + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS * MAX_LEVS) + ret = PIO_put_var(pio_file, pio_4dvar, start, count,& + pval_3d(:,:,:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 4d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:536)" + END IF + RETURN + END IF + end do + ! ncdf_get_put.F90.in:538 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:540 + ret = PIO_get_var(pio_file, pio_2dvar, gval_2d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 2d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:542)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:543 + + IF (.NOT. PIO_TF_Check_val_(gval_2d, exp_val_2d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (2d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:544)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:545 + ret = PIO_get_var(pio_file, pio_3dvar, gval_3d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 3d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:547)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:548 + + IF (.NOT. PIO_TF_Check_val_(gval_3d, exp_val_3d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (3d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:549)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:550 + ret = PIO_get_var(pio_file, pio_4dvar, gval_4d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 4d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:552)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:553 + ! Special code to handle 4d vals is required since the framework + ! currently does not support comparing 4d arrays + do tstep=1,MAX_TIMES + + IF (.NOT. PIO_TF_Check_val_(gval_4d(:,:,:,tstep), exp_val_4d(:,:,:,tstep))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (4d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:557)" + END IF + RETURN + END IF + end do + ! ncdf_get_put.F90.in:559 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:567 +END SUBROUTINE test_put_get_md2mdplus1_var_PIO_int_integer__ + + +SUBROUTINE test_put_get_md2mdplus1_var_PIO_real_real_kind_fc_real___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + integer, parameter :: MAX_DIMS = 4 + integer, parameter :: MAX_ROWS = 10 + integer, parameter :: MAX_COLS = 10 + integer, parameter :: MAX_LEVS = 3 + integer, parameter :: MAX_TIMES = 3 + integer, dimension(MAX_DIMS) :: pio_dims + type(var_desc_t) :: pio_2dvar, pio_3dvar, pio_4dvar + real(kind=fc_real), dimension(MAX_ROWS,MAX_TIMES) :: gval_2d, exp_val_2d + real(kind=fc_real), dimension(MAX_ROWS,MAX_COLS,MAX_TIMES) :: gval_3d, exp_val_3d + real(kind=fc_real), dimension(MAX_ROWS,MAX_COLS,MAX_LEVS,MAX_TIMES) ::& + gval_4d, exp_val_4d + ! Only one slice is written out at a time + ! pval_1d is a 1d slice of gval_2d ... + real(kind=fc_real), dimension(MAX_ROWS) :: pval_1d + real(kind=fc_real), dimension(MAX_ROWS, MAX_COLS) :: pval_2d + real(kind=fc_real), dimension(MAX_ROWS, MAX_COLS, MAX_LEVS) :: pval_3d + integer, dimension(:) :: start(MAX_DIMS), count(MAX_DIMS) + integer :: pval_start + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, k, l, m, n, tstep, ret + + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put_md_slice.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:431)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:432 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'nrows', MAX_ROWS, pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:435)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:436 + ret = PIO_def_dim(pio_file, 'ncols', MAX_COLS, pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:438)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:439 + ret = PIO_def_dim(pio_file, 'nlevs', MAX_LEVS, pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:441)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:442 + ret = PIO_def_dim(pio_file, 'timesteps', MAX_TIMES, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:444)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:445 + ret = PIO_def_var(pio_file, '2d_val', PIO_real,& + (/pio_dims(1),pio_dims(4)/), pio_2dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:448)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:449 + ret = PIO_def_var(pio_file, '3d_val', PIO_real,& + (/pio_dims(1),pio_dims(2),pio_dims(4)/), pio_3dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:452)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:453 + ret = PIO_def_var(pio_file, '4d_val', PIO_real,& + pio_dims, pio_4dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:456)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:457 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:459)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:460 + ! Put vals are for each timestep & + ! expected vals are combined for all timesteps + do k=1,MAX_ROWS + pval_1d(k) = k + end do + do tstep=1,MAX_TIMES + pval_start = (tstep - 1) * MAX_ROWS + exp_val_2d(:,tstep) = pval_1d + pval_start + end do + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_2d(k,l) = (l - 1)*MAX_ROWS + k + end do + end do + do tstep=1,MAX_TIMES + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS) + exp_val_3d(:,:,tstep) = pval_2d + pval_start + end do + end do + end do + do m=1,MAX_LEVS + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_3d(k,l,m) = ((m-1)*(MAX_COLS*MAX_ROWS)+(l - 1)*MAX_ROWS + k) + end do + end do + end do + do tstep=1,MAX_TIMES + do m=1,MAX_LEVS + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS * MAX_LEVS) + exp_val_4d(:,:,:,tstep) = pval_3d + pval_start + end do + end do + end do + end do + ! Put 2d/3d/4d vals, one timestep at a time + do tstep=1,MAX_TIMES + start = 0 + count = 0 + ! ncdf_get_put.F90.in:504 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = tstep + count(2) = 1 + pval_start = (tstep - 1) * MAX_ROWS + ret = PIO_put_var(pio_file, pio_2dvar, start, count,& + pval_1d(:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 2d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:512)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:513 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = 1 + count(2) = MAX_COLS + start(3) = tstep + count(3) = 1 + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS) + ret = PIO_put_var(pio_file, pio_3dvar, start, count,& + pval_2d(:,:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 3d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:523)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:524 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = 1 + count(2) = MAX_COLS + start(3) = 1 + count(3) = MAX_LEVS + start(4) = tstep + count(4) = 1 + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS * MAX_LEVS) + ret = PIO_put_var(pio_file, pio_4dvar, start, count,& + pval_3d(:,:,:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 4d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:536)" + END IF + RETURN + END IF + end do + ! ncdf_get_put.F90.in:538 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:540 + ret = PIO_get_var(pio_file, pio_2dvar, gval_2d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 2d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:542)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:543 + + IF (.NOT. PIO_TF_Check_val_(gval_2d, exp_val_2d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (2d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:544)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:545 + ret = PIO_get_var(pio_file, pio_3dvar, gval_3d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 3d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:547)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:548 + + IF (.NOT. PIO_TF_Check_val_(gval_3d, exp_val_3d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (3d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:549)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:550 + ret = PIO_get_var(pio_file, pio_4dvar, gval_4d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 4d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:552)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:553 + ! Special code to handle 4d vals is required since the framework + ! currently does not support comparing 4d arrays + do tstep=1,MAX_TIMES + + IF (.NOT. PIO_TF_Check_val_(gval_4d(:,:,:,tstep), exp_val_4d(:,:,:,tstep))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (4d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:557)" + END IF + RETURN + END IF + end do + ! ncdf_get_put.F90.in:559 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:567 +END SUBROUTINE test_put_get_md2mdplus1_var_PIO_real_real_kind_fc_real___ + + +SUBROUTINE test_put_get_md2mdplus1_var_PIO_double_real_kind_fc_double___ +USE pio_tutil + + Implicit none + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + integer, parameter :: MAX_DIMS = 4 + integer, parameter :: MAX_ROWS = 10 + integer, parameter :: MAX_COLS = 10 + integer, parameter :: MAX_LEVS = 3 + integer, parameter :: MAX_TIMES = 3 + integer, dimension(MAX_DIMS) :: pio_dims + type(var_desc_t) :: pio_2dvar, pio_3dvar, pio_4dvar + real(kind=fc_double), dimension(MAX_ROWS,MAX_TIMES) :: gval_2d, exp_val_2d + real(kind=fc_double), dimension(MAX_ROWS,MAX_COLS,MAX_TIMES) :: gval_3d, exp_val_3d + real(kind=fc_double), dimension(MAX_ROWS,MAX_COLS,MAX_LEVS,MAX_TIMES) ::& + gval_4d, exp_val_4d + ! Only one slice is written out at a time + ! pval_1d is a 1d slice of gval_2d ... + real(kind=fc_double), dimension(MAX_ROWS) :: pval_1d + real(kind=fc_double), dimension(MAX_ROWS, MAX_COLS) :: pval_2d + real(kind=fc_double), dimension(MAX_ROWS, MAX_COLS, MAX_LEVS) :: pval_3d + integer, dimension(:) :: start(MAX_DIMS), count(MAX_DIMS) + integer :: pval_start + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + integer :: i, k, l, m, n, tstep, ret + + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_ncdf_get_put_md_slice.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:431)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:432 + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, 'nrows', MAX_ROWS, pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:435)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:436 + ret = PIO_def_dim(pio_file, 'ncols', MAX_COLS, pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:438)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:439 + ret = PIO_def_dim(pio_file, 'nlevs', MAX_LEVS, pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:441)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:442 + ret = PIO_def_dim(pio_file, 'timesteps', MAX_TIMES, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:444)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:445 + ret = PIO_def_var(pio_file, '2d_val', PIO_double,& + (/pio_dims(1),pio_dims(4)/), pio_2dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:448)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:449 + ret = PIO_def_var(pio_file, '3d_val', PIO_double,& + (/pio_dims(1),pio_dims(2),pio_dims(4)/), pio_3dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:452)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:453 + ret = PIO_def_var(pio_file, '4d_val', PIO_double,& + pio_dims, pio_4dvar) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:456)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:457 + ret = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:459)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:460 + ! Put vals are for each timestep & + ! expected vals are combined for all timesteps + do k=1,MAX_ROWS + pval_1d(k) = k + end do + do tstep=1,MAX_TIMES + pval_start = (tstep - 1) * MAX_ROWS + exp_val_2d(:,tstep) = pval_1d + pval_start + end do + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_2d(k,l) = (l - 1)*MAX_ROWS + k + end do + end do + do tstep=1,MAX_TIMES + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS) + exp_val_3d(:,:,tstep) = pval_2d + pval_start + end do + end do + end do + do m=1,MAX_LEVS + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_3d(k,l,m) = ((m-1)*(MAX_COLS*MAX_ROWS)+(l - 1)*MAX_ROWS + k) + end do + end do + end do + do tstep=1,MAX_TIMES + do m=1,MAX_LEVS + do l=1,MAX_COLS + do k=1,MAX_ROWS + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS * MAX_LEVS) + exp_val_4d(:,:,:,tstep) = pval_3d + pval_start + end do + end do + end do + end do + ! Put 2d/3d/4d vals, one timestep at a time + do tstep=1,MAX_TIMES + start = 0 + count = 0 + ! ncdf_get_put.F90.in:504 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = tstep + count(2) = 1 + pval_start = (tstep - 1) * MAX_ROWS + ret = PIO_put_var(pio_file, pio_2dvar, start, count,& + pval_1d(:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 2d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:512)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:513 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = 1 + count(2) = MAX_COLS + start(3) = tstep + count(3) = 1 + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS) + ret = PIO_put_var(pio_file, pio_3dvar, start, count,& + pval_2d(:,:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 3d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:523)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:524 + start(1) = 1 + count(1) = MAX_ROWS + start(2) = 1 + count(2) = MAX_COLS + start(3) = 1 + count(3) = MAX_LEVS + start(4) = tstep + count(4) = 1 + pval_start = (tstep - 1) * (MAX_ROWS * MAX_COLS * MAX_LEVS) + ret = PIO_put_var(pio_file, pio_4dvar, start, count,& + pval_3d(:,:,:)+pval_start) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put 4d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:536)" + END IF + RETURN + END IF + end do + ! ncdf_get_put.F90.in:538 + call PIO_syncfile(pio_file) + ! ncdf_get_put.F90.in:540 + ret = PIO_get_var(pio_file, pio_2dvar, gval_2d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 2d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:542)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:543 + + IF (.NOT. PIO_TF_Check_val_(gval_2d, exp_val_2d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (2d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:544)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:545 + ret = PIO_get_var(pio_file, pio_3dvar, gval_3d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 3d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:547)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:548 + + IF (.NOT. PIO_TF_Check_val_(gval_3d, exp_val_3d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (3d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:549)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:550 + ret = PIO_get_var(pio_file, pio_4dvar, gval_4d) + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get 4d var:" // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:552)" + END IF + RETURN + END IF + ! ncdf_get_put.F90.in:553 + ! Special code to handle 4d vals is required since the framework + ! currently does not support comparing 4d arrays + do tstep=1,MAX_TIMES + + IF (.NOT. PIO_TF_Check_val_(gval_4d(:,:,:,tstep), exp_val_4d(:,:,:,tstep))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong value (4d var)",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_get_put.F90.in:557)" + END IF + RETURN + END IF + end do + ! ncdf_get_put.F90.in:559 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! ncdf_get_put.F90.in:567 +END SUBROUTINE test_put_get_md2mdplus1_var_PIO_double_real_kind_fc_double___ + ! ncdf_get_put.F90.in:568 + + + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_int_integer__" + END IF + CALL test_put_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "test_put_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "test_put_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_int_integer__" + END IF + CALL test_put_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "test_put_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "test_put_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_int_integer__" + END IF + CALL test_put_get_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_int_integer__" + END IF + CALL test_put_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "test_put_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "test_put_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_int_integer__" + END IF + CALL test_put_get_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_int_integer__" + END IF + CALL test_put_get_0dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_0dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_0dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_int_integer__" + END IF + CALL test_put_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 19:",& + "test_put_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 19:",& + "test_put_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 20:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 20:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 21:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 21:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_int_integer__" + END IF + CALL test_put_get_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 22:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 22:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 23:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 23:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 24:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 24:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_int_integer__" + END IF + CALL test_put_get_0dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 25:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 25:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_0dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 26:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 26:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_0dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 27:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 27:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 28:",& + "test_put_get_1dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 28:",& + "test_put_get_1dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 29:",& + "test_put_get_1dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 29:",& + "test_put_get_1dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 30:",& + "test_put_get_1dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 30:",& + "test_put_get_1dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_int_integer__" + END IF + CALL test_put_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 31:",& + "test_put_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 31:",& + "test_put_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 32:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 32:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 33:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 33:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_int_integer__" + END IF + CALL test_put_get_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 34:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 34:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 35:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 35:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 36:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 36:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_int_integer__" + END IF + CALL test_put_get_0dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 37:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 37:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_0dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 38:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 38:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_0dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 39:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 39:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 40:",& + "test_put_get_1dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 40:",& + "test_put_get_1dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 41:",& + "test_put_get_1dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 41:",& + "test_put_get_1dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 42:",& + "test_put_get_1dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 42:",& + "test_put_get_1dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_slice_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 43:",& + "test_put_get_1dvar_slice_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 43:",& + "test_put_get_1dvar_slice_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 44:",& + "test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 44:",& + "test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 45:",& + "test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 45:",& + "test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_int_integer__" + END IF + CALL test_put_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 46:",& + "test_put_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 46:",& + "test_put_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 47:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 47:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 48:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 48:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_int_integer__" + END IF + CALL test_put_get_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 49:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 49:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 50:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 50:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 51:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 51:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_int_integer__" + END IF + CALL test_put_get_0dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 52:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 52:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_0dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 53:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 53:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_0dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 54:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 54:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 55:",& + "test_put_get_1dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 55:",& + "test_put_get_1dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 56:",& + "test_put_get_1dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 56:",& + "test_put_get_1dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 57:",& + "test_put_get_1dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 57:",& + "test_put_get_1dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_slice_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 58:",& + "test_put_get_1dvar_slice_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 58:",& + "test_put_get_1dvar_slice_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 59:",& + "test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 59:",& + "test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 60:",& + "test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 60:",& + "test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_4parts_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_4parts_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 61:",& + "test_put_get_1dvar_4parts_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 61:",& + "test_put_get_1dvar_4parts_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 62:",& + "test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 62:",& + "test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 63:",& + "test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 63:",& + "test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_int_integer__" + END IF + CALL test_put_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 64:",& + "test_put_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 64:",& + "test_put_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 65:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 65:",& + "test_put_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 66:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 66:",& + "test_put_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_int_integer__" + END IF + CALL test_put_get_1datt_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 67:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 67:",& + "test_put_get_1datt_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1datt_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 68:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 68:",& + "test_put_get_1datt_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1datt_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1datt_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 69:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 69:",& + "test_put_get_1datt_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_int_integer__" + END IF + CALL test_put_get_0dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 70:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 70:",& + "test_put_get_0dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_0dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 71:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 71:",& + "test_put_get_0dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_0dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_0dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 72:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 72:",& + "test_put_get_0dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 73:",& + "test_put_get_1dvar_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 73:",& + "test_put_get_1dvar_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 74:",& + "test_put_get_1dvar_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 74:",& + "test_put_get_1dvar_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 75:",& + "test_put_get_1dvar_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 75:",& + "test_put_get_1dvar_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_slice_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 76:",& + "test_put_get_1dvar_slice_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 76:",& + "test_put_get_1dvar_slice_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 77:",& + "test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 77:",& + "test_put_get_1dvar_slice_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 78:",& + "test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 78:",& + "test_put_get_1dvar_slice_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_4parts_PIO_int_integer__" + END IF + CALL test_put_get_1dvar_4parts_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 79:",& + "test_put_get_1dvar_4parts_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 79:",& + "test_put_get_1dvar_4parts_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 80:",& + "test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 80:",& + "test_put_get_1dvar_4parts_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 81:",& + "test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 81:",& + "test_put_get_1dvar_4parts_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_md2mdplus1_var_PIO_int_integer__" + END IF + CALL test_put_get_md2mdplus1_var_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 82:",& + "test_put_get_md2mdplus1_var_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 82:",& + "test_put_get_md2mdplus1_var_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_md2mdplus1_var_PIO_real_real_kind_fc_real___" + END IF + CALL test_put_get_md2mdplus1_var_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 83:",& + "test_put_get_md2mdplus1_var_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 83:",& + "test_put_get_md2mdplus1_var_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_put_get_md2mdplus1_var_PIO_double_real_kind_fc_double___" + END IF + CALL test_put_get_md2mdplus1_var_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 84:",& + "test_put_get_md2mdplus1_var_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 84:",& + "test_put_get_md2mdplus1_var_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/ncdf_inq.F90.in2 b/tests/general/ncdf_inq.F90.in2 new file mode 100644 index 00000000000..66517f13fa2 --- /dev/null +++ b/tests/general/ncdf_inq.F90.in2 @@ -0,0 +1,577 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/ncdf_inq.F90.in + +MODULE ncdf_inq_tests_tgv ! ncdf_inq.F90.in:1 + use pio_tutil ! ncdf_inq.F90.in:2 + character(len=PIO_TF_MAX_STR_LEN), parameter :: tgv_fname = "pio_ncdf_inq_test_file.nc" ! ncdf_inq.F90.in:3 + integer :: tgv_iotype ! ncdf_inq.F90.in:4 + character(len=PIO_TF_MAX_STR_LEN), parameter :: tgv_var_name = "dummy_var" ! ncdf_inq.F90.in:5 + integer, parameter :: tgv_var_ndims = 1 ! ncdf_inq.F90.in:6 + character(len=PIO_TF_MAX_STR_LEN), parameter :: tgv_dim_name = "dummy_dim" ! ncdf_inq.F90.in:7 + integer, parameter :: TGV_DIM_LEN = 100 ! ncdf_inq.F90.in:8 + integer, parameter :: tgv_var_natts = 2 ! ncdf_inq.F90.in:9 + character(len=PIO_TF_MAX_STR_LEN), parameter :: tgv_iatt_name = "dummy_iatt" ! ncdf_inq.F90.in:10 + integer, parameter :: tgv_iatt_val = 3 ! ncdf_inq.F90.in:11 + character(len=PIO_TF_MAX_STR_LEN), parameter :: tgv_catt_name = "dummy_catt" ! ncdf_inq.F90.in:12 + integer, parameter :: TGV_ATT_LEN = 100 ! ncdf_inq.F90.in:13 + character(len=TGV_ATT_LEN) :: tgv_catt_val = "DUMMY_STR" ! ncdf_inq.F90.in:14 +END MODULE ncdf_inq_tests_tgv ! ncdf_inq.F90.in:15 + + +SUBROUTINE test_setup(ret) ! ncdf_inq.F90.in:17 + use pio_tutil ! ncdf_inq.F90.in:18 + use ncdf_inq_tests_tgv ! ncdf_inq.F90.in:19 + implicit none ! ncdf_inq.F90.in:20 + + + integer, intent(out) :: ret ! ncdf_inq.F90.in:22 + + + type(file_desc_t) :: pio_file ! ncdf_inq.F90.in:24 + type(var_desc_t) :: pio_var ! ncdf_inq.F90.in:25 + integer :: pio_dim ! ncdf_inq.F90.in:26 + real, dimension(TGV_DIM_LEN) :: val ! ncdf_inq.F90.in:27 + integer, dimension(TGV_ATT_LEN) :: iatt ! ncdf_inq.F90.in:28 + CHARACTER(len=TGV_ATT_LEN) :: catt ! ncdf_inq.F90.in:29 + + + ret = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname, PIO_CLOBBER) ! ncdf_inq.F90.in:31 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:32)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:32 + + + ! Since file is just created no need to enter redef + ret = PIO_def_dim(pio_file, tgv_dim_name, TGV_DIM_LEN, pio_dim) ! ncdf_inq.F90.in:35 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:36)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:36 + + + ret = PIO_def_var(pio_file, tgv_var_name, pio_real, (/pio_dim/), pio_var) ! ncdf_inq.F90.in:38 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:39)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:39 + + + iatt = tgv_iatt_val ! ncdf_inq.F90.in:41 + ret = PIO_put_att(pio_file, pio_var, tgv_iatt_name, iatt); ! ncdf_inq.F90.in:42 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put attribute:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:43)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:43 + + + catt = tgv_catt_val ! ncdf_inq.F90.in:45 + ret = PIO_put_att(pio_file, pio_var, tgv_catt_name, catt); ! ncdf_inq.F90.in:46 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put attribute:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:47)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:47 + + + ret = PIO_enddef(pio_file) ! ncdf_inq.F90.in:49 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:50)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:50 + + + val = pio_tf_world_rank_ ! ncdf_inq.F90.in:52 + ret = PIO_put_var(pio_file, pio_var, val) ! ncdf_inq.F90.in:53 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put var: " // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:54)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:54 + + + call PIO_closefile(pio_file) ! ncdf_inq.F90.in:56 +END SUBROUTINE test_setup ! ncdf_inq.F90.in:57 + + +SUBROUTINE test_teardown(ret) ! ncdf_inq.F90.in:59 + use pio_tutil ! ncdf_inq.F90.in:60 + use ncdf_inq_tests_tgv ! ncdf_inq.F90.in:61 + implicit none ! ncdf_inq.F90.in:62 + + + integer, intent(out) :: ret ! ncdf_inq.F90.in:64 + + + ret = PIO_NOERR ! ncdf_inq.F90.in:66 + call PIO_deletefile(pio_tf_iosystem_, tgv_fname) ! ncdf_inq.F90.in:67 +END SUBROUTINE test_teardown ! ncdf_inq.F90.in:68 + + +SUBROUTINE test_inq_var(pio_file, ret) ! ncdf_inq.F90.in:70 + use pio_tutil ! ncdf_inq.F90.in:71 + use ncdf_inq_tests_tgv ! ncdf_inq.F90.in:72 + implicit none ! ncdf_inq.F90.in:73 + + + type(file_desc_t), intent(in) :: pio_file ! ncdf_inq.F90.in:75 + integer, intent(inout) :: ret ! ncdf_inq.F90.in:76 + + + type(var_desc_t) :: pio_var ! ncdf_inq.F90.in:78 + integer :: var_id, var_type, var_ndims, var_natts ! ncdf_inq.F90.in:79 + integer, dimension(:), allocatable :: var_dims ! ncdf_inq.F90.in:80 + character(len=pio_max_name) :: var_name ! ncdf_inq.F90.in:81 + + + ret = pio_inq_varid(pio_file, tgv_var_name, var_id) ! ncdf_inq.F90.in:83 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inquire varid :"//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:84)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:84 + + + ret = pio_inq_varname(pio_file, var_id, var_name) ! ncdf_inq.F90.in:86 + + IF (.NOT. (PIO_TF_Passert_(var_name .eq. tgv_var_name, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Variable name is not the expected value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:87)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:87 + + + ret = pio_inq_vartype(pio_file, var_id, var_type) ! ncdf_inq.F90.in:89 + + IF (.NOT. (PIO_TF_Passert_(var_type == PIO_real, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Variable tye is not the expected type",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:90)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:90 + + + ret = pio_inq_varndims(pio_file, var_id, var_ndims) ! ncdf_inq.F90.in:92 + + IF (.NOT. (PIO_TF_Passert_(var_ndims == tgv_var_ndims, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Num of dims for variable is not expected",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:93)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:93 + + + allocate(var_dims(var_ndims)) ! ncdf_inq.F90.in:95 + ret = pio_inq_vardimid(pio_file, var_id, var_dims) ! ncdf_inq.F90.in:96 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get dim ids:"//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:97)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:97 + deallocate(var_dims) ! ncdf_inq.F90.in:98 + + + ret = pio_inq_varnatts(pio_file, var_id, var_natts) ! ncdf_inq.F90.in:100 + + IF (.NOT. (PIO_TF_Passert_(var_natts == tgv_var_natts, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Num of atts for variable is not expected",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:101)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:101 + + +END SUBROUTINE test_inq_var ! ncdf_inq.F90.in:103 + + +SUBROUTINE test_inq_dim(pio_file, ret) ! ncdf_inq.F90.in:105 + use pio_tutil ! ncdf_inq.F90.in:106 + use ncdf_inq_tests_tgv ! ncdf_inq.F90.in:107 + implicit none ! ncdf_inq.F90.in:108 + + + type(file_desc_t), intent(in) :: pio_file ! ncdf_inq.F90.in:110 + integer, intent(inout) :: ret ! ncdf_inq.F90.in:111 + + + integer :: dim_id ! ncdf_inq.F90.in:113 + character(len=pio_max_name) :: dim_name ! ncdf_inq.F90.in:114 + integer(kind=pio_offset_kind) :: dim_len ! ncdf_inq.F90.in:115 + + + ret = pio_inq_dimid(pio_file, tgv_dim_name, dim_id) ! ncdf_inq.F90.in:117 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inq dimid :"//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:118)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:118 + + + ret = pio_inq_dimname(pio_file, dim_id, dim_name) ! ncdf_inq.F90.in:120 + + IF (.NOT. (PIO_TF_Passert_(dim_name .eq. tgv_dim_name, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Dim name is not the expected value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:121)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:121 + + + ret = pio_inq_dimlen(pio_file, dim_id, dim_len) ! ncdf_inq.F90.in:123 + + IF (.NOT. (PIO_TF_Passert_(dim_len == TGV_DIM_LEN, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Dim length is not the expected value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:124)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:124 + + +END SUBROUTINE test_inq_dim ! ncdf_inq.F90.in:126 + + +SUBROUTINE test_inq_att(pio_file, ret) ! ncdf_inq.F90.in:128 + use pio_tutil ! ncdf_inq.F90.in:129 + use ncdf_inq_tests_tgv ! ncdf_inq.F90.in:130 + implicit none ! ncdf_inq.F90.in:131 + + + type(file_desc_t), intent(inout) :: pio_file ! ncdf_inq.F90.in:133 + integer, intent(inout) :: ret ! ncdf_inq.F90.in:134 + + + integer :: var_id ! ncdf_inq.F90.in:136 + integer(kind=pio_offset_kind) :: att_len ! ncdf_inq.F90.in:137 + + + ret = pio_inq_varid(pio_file, tgv_var_name, var_id) ! ncdf_inq.F90.in:139 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inquire varid :"//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:140)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:140 + + + ret = pio_inq_attlen(pio_file, var_id, tgv_iatt_name, att_len) ! ncdf_inq.F90.in:142 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inquire att len :"//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:143)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:143 + !PIO_TF_PASSERT(att_len == tgv_iatt_len, "Att length is not expected value") + + + ret = pio_inq_attlen(pio_file, var_id, tgv_catt_name, att_len) ! ncdf_inq.F90.in:146 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inquire att len :"//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:147)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:147 + + IF (.NOT. (PIO_TF_Passert_(att_len == len(trim(tgv_catt_val)), pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Attribute length is not expected value",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:148)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:148 + + +END SUBROUTINE test_inq_att ! ncdf_inq.F90.in:150 + + +SUBROUTINE test_inq + USE pio_tutil + ! ncdf_inq.F90.in:152 + use ncdf_inq_tests_tgv ! ncdf_inq.F90.in:153 + Implicit none ! ncdf_inq.F90.in:154 + type(file_desc_t) :: pio_file ! ncdf_inq.F90.in:155 + integer, dimension(:), allocatable :: iotypes ! ncdf_inq.F90.in:156 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! ncdf_inq.F90.in:157 + integer :: num_iotypes ! ncdf_inq.F90.in:158 + integer :: i, ret ! ncdf_inq.F90.in:159 + + + num_iotypes = 0 ! ncdf_inq.F90.in:161 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! ncdf_inq.F90.in:162 + do i=1,num_iotypes ! ncdf_inq.F90.in:163 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type :", iotype_descs(i) + END IF + END IF ! ncdf_inq.F90.in:164 + tgv_iotype = iotypes(i) ! ncdf_inq.F90.in:165 + + + call test_setup(ret) ! ncdf_inq.F90.in:167 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Test setup failed",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:168)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:168 + + + ret = PIO_openfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname, PIO_nowrite) ! ncdf_inq.F90.in:170 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open: "// trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:171)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:171 + + + call test_inq_var(pio_file, ret) ! ncdf_inq.F90.in:173 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inq var:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:174)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:174 + + + call test_inq_dim(pio_file, ret) ! ncdf_inq.F90.in:176 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inq dim:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:177)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:177 + + + call test_inq_att(pio_file, ret) ! ncdf_inq.F90.in:179 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inq att:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:180)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:180 + + + call PIO_closefile(pio_file) ! ncdf_inq.F90.in:182 + + + call test_teardown(ret) ! ncdf_inq.F90.in:184 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Test teardown failed",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_inq.F90.in:185)" + END IF + RETURN + END IF ! ncdf_inq.F90.in:185 + end do ! ncdf_inq.F90.in:186 + if(allocated(iotypes)) then ! ncdf_inq.F90.in:187 + deallocate(iotypes) ! ncdf_inq.F90.in:188 + deallocate(iotype_descs) ! ncdf_inq.F90.in:189 + end if ! ncdf_inq.F90.in:190 + + +END SUBROUTINE test_inq ! ncdf_inq.F90.in:192 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_inq" + END IF + CALL test_inq() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "test_inq","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "test_inq","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/ncdf_simple_tests.F90.in2 b/tests/general/ncdf_simple_tests.F90.in2 new file mode 100644 index 00000000000..0021d053064 --- /dev/null +++ b/tests/general/ncdf_simple_tests.F90.in2 @@ -0,0 +1,950 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/ncdf_simple_tests.F90.in + +MODULE ncdf_simple_tests_tgv ! ncdf_simple_tests.F90.in:1 + use pio_tutil ! ncdf_simple_tests.F90.in:2 + ! tgv in prefix corresponds to module name (ncdf_simple_tests_tgv) + character(len=PIO_TF_MAX_STR_LEN), parameter :: tgv_fname = "pio_ncdf_test_file.nc" ! ncdf_simple_tests.F90.in:4 + integer :: tgv_iotype ! ncdf_simple_tests.F90.in:5 +END MODULE ncdf_simple_tests_tgv ! ncdf_simple_tests.F90.in:6 + + +SUBROUTINE test_clobber + USE pio_tutil + ! ncdf_simple_tests.F90.in:8 + use ncdf_simple_tests_tgv ! ncdf_simple_tests.F90.in:9 + Implicit none ! ncdf_simple_tests.F90.in:10 + type(file_desc_t) :: pio_file ! ncdf_simple_tests.F90.in:11 + character(len=PIO_TF_MAX_STR_LEN), parameter :: clob_fname = "pio_test_clobber.nc" ! ncdf_simple_tests.F90.in:12 + integer :: ret ! ncdf_simple_tests.F90.in:13 + + + ! Default is NOCLOBBER + ret = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, clob_fname) ! ncdf_simple_tests.F90.in:16 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create:" // trim(clob_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:17)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:17 + + + call PIO_closefile(pio_file) ! ncdf_simple_tests.F90.in:19 + + + ! Recrate with CLOBBER option - should erase existing file and create new one + ret = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, clob_fname, PIO_CLOBBER) ! ncdf_simple_tests.F90.in:22 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create (with CLOBBER):" // trim(clob_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:23)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:23 + + + call PIO_closefile(pio_file) ! ncdf_simple_tests.F90.in:25 + call PIO_deletefile(pio_tf_iosystem_, clob_fname) ! ncdf_simple_tests.F90.in:26 + + +END SUBROUTINE test_clobber ! ncdf_simple_tests.F90.in:28 + + +SUBROUTINE test_redef_enddef + USE pio_tutil + ! ncdf_simple_tests.F90.in:30 + use ncdf_simple_tests_tgv ! ncdf_simple_tests.F90.in:31 + Implicit none ! ncdf_simple_tests.F90.in:32 + type(file_desc_t) :: pio_file ! ncdf_simple_tests.F90.in:33 + integer :: ret ! ncdf_simple_tests.F90.in:34 + + + ret = PIO_openfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname, PIO_write) ! ncdf_simple_tests.F90.in:36 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:37)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:37 + + + ! A simple redef and then enddef + ret = PIO_redef(pio_file) ! ncdf_simple_tests.F90.in:40 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to redef:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:41)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:41 + + + ret = PIO_enddef(pio_file) ! ncdf_simple_tests.F90.in:43 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:44)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:44 + + + call PIO_closefile(pio_file) ! ncdf_simple_tests.F90.in:46 + + +END SUBROUTINE test_redef_enddef ! ncdf_simple_tests.F90.in:48 + + +SUBROUTINE test_def_dim + USE pio_tutil + ! ncdf_simple_tests.F90.in:50 + use ncdf_simple_tests_tgv ! ncdf_simple_tests.F90.in:51 + Implicit none ! ncdf_simple_tests.F90.in:52 + type(file_desc_t) :: pio_file ! ncdf_simple_tests.F90.in:53 + integer :: pio_dim ! ncdf_simple_tests.F90.in:54 + integer :: ret ! ncdf_simple_tests.F90.in:55 + + + ret = PIO_openfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname, PIO_write) ! ncdf_simple_tests.F90.in:57 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:58)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:58 + + + ! A simple redef and then enddef + ret = PIO_redef(pio_file) ! ncdf_simple_tests.F90.in:61 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to redef:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:62)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:62 + + + ret = PIO_def_dim(pio_file, 'dummy_dim_def_dim', 100, pio_dim) ! ncdf_simple_tests.F90.in:64 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:65)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:65 + + + ret = PIO_enddef(pio_file) ! ncdf_simple_tests.F90.in:67 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:68)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:68 + + + call PIO_closefile(pio_file) ! ncdf_simple_tests.F90.in:70 + + +END SUBROUTINE test_def_dim ! ncdf_simple_tests.F90.in:72 + + +SUBROUTINE test_def_var + USE pio_tutil + ! ncdf_simple_tests.F90.in:74 + use ncdf_simple_tests_tgv ! ncdf_simple_tests.F90.in:75 + Implicit none ! ncdf_simple_tests.F90.in:76 + type(file_desc_t) :: pio_file ! ncdf_simple_tests.F90.in:77 + type(var_desc_t) :: pio_var ! ncdf_simple_tests.F90.in:78 + integer :: pio_dim ! ncdf_simple_tests.F90.in:79 + integer :: ret ! ncdf_simple_tests.F90.in:80 + + + ret = PIO_openfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname, PIO_write) ! ncdf_simple_tests.F90.in:82 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:83)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:83 + + + ! A simple redef and then enddef + ret = PIO_redef(pio_file) ! ncdf_simple_tests.F90.in:86 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to redef:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:87)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:87 + + + ret = PIO_def_dim(pio_file, 'dummy_dim_def_var', 100, pio_dim) ! ncdf_simple_tests.F90.in:89 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:90)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:90 + + + ret = PIO_def_var(pio_file, 'dummy_var_def_var', PIO_int, (/pio_dim/), pio_var) ! ncdf_simple_tests.F90.in:92 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:93)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:93 + + + ret = PIO_enddef(pio_file) ! ncdf_simple_tests.F90.in:95 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:96)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:96 + + + call PIO_closefile(pio_file) ! ncdf_simple_tests.F90.in:98 + + +END SUBROUTINE test_def_var ! ncdf_simple_tests.F90.in:100 + + + + +SUBROUTINE test_data_conversion_PIO_int_integer__ +USE pio_tutil + + use ncdf_simple_tests_tgv + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: data_fname = "pio_test_data_conversion_PIO_int_integer__.nc" + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + integer, dimension(VEC_LOCAL_SZ) :: wbuf + integer, dimension(VEC_LOCAL_SZ) :: rbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr + ! ncdf_simple_tests.F90.in:117 + ! ncdf_simple_tests.F90.in:118 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wbuf = pio_tf_world_rank_; + exp_val = pio_tf_world_rank_; + ! ncdf_simple_tests.F90.in:126 + ! Set the decomposition for writing data as PIO_int + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wiodesc) + ! ncdf_simple_tests.F90.in:129 + ! Set the decomposition for reading data as various types + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, riodesc) + ! ncdf_simple_tests.F90.in:132 + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, data_fname, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:134)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:135 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:137)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:138 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:140)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:141 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:143)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:144 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:147)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:148 + call PIO_syncfile(pio_file) + ! ncdf_simple_tests.F90.in:150 + if (tgv_iotype .eq. PIO_iotype_pnetcdf) then + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "WARNING: Data type conversion not supported in pnetcdf vard interface, skipping test" + END IF + END IF + else + ! Read the variable back (data conversion might occur) + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:156)" + END IF + RETURN + END IF + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:157)" + END IF + RETURN + END IF + endif + ! ncdf_simple_tests.F90.in:159 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, data_fname); + ! ncdf_simple_tests.F90.in:162 + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + ! ncdf_simple_tests.F90.in:165 +END SUBROUTINE test_data_conversion_PIO_int_integer__ + + +SUBROUTINE test_data_conversion_PIO_real_real_kind_fc_real___ +USE pio_tutil + + use ncdf_simple_tests_tgv + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: data_fname = "pio_test_data_conversion_PIO_real_real_kind_fc_real___.nc" + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + integer, dimension(VEC_LOCAL_SZ) :: wbuf + real(kind=fc_real), dimension(VEC_LOCAL_SZ) :: rbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr + ! ncdf_simple_tests.F90.in:117 + ! ncdf_simple_tests.F90.in:118 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wbuf = pio_tf_world_rank_; + exp_val = pio_tf_world_rank_; + ! ncdf_simple_tests.F90.in:126 + ! Set the decomposition for writing data as PIO_int + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wiodesc) + ! ncdf_simple_tests.F90.in:129 + ! Set the decomposition for reading data as various types + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, riodesc) + ! ncdf_simple_tests.F90.in:132 + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, data_fname, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:134)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:135 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:137)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:138 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:140)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:141 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:143)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:144 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:147)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:148 + call PIO_syncfile(pio_file) + ! ncdf_simple_tests.F90.in:150 + if (tgv_iotype .eq. PIO_iotype_pnetcdf) then + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "WARNING: Data type conversion not supported in pnetcdf vard interface, skipping test" + END IF + END IF + else + ! Read the variable back (data conversion might occur) + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:156)" + END IF + RETURN + END IF + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:157)" + END IF + RETURN + END IF + endif + ! ncdf_simple_tests.F90.in:159 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, data_fname); + ! ncdf_simple_tests.F90.in:162 + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + ! ncdf_simple_tests.F90.in:165 +END SUBROUTINE test_data_conversion_PIO_real_real_kind_fc_real___ + + +SUBROUTINE test_data_conversion_PIO_double_real_kind_fc_double___ +USE pio_tutil + + use ncdf_simple_tests_tgv + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: data_fname = "pio_test_data_conversion_PIO_double_real_kind_fc_double___.nc" + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + integer, dimension(VEC_LOCAL_SZ) :: wbuf + real(kind=fc_double), dimension(VEC_LOCAL_SZ) :: rbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr + ! ncdf_simple_tests.F90.in:117 + ! ncdf_simple_tests.F90.in:118 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wbuf = pio_tf_world_rank_; + exp_val = pio_tf_world_rank_; + ! ncdf_simple_tests.F90.in:126 + ! Set the decomposition for writing data as PIO_int + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wiodesc) + ! ncdf_simple_tests.F90.in:129 + ! Set the decomposition for reading data as various types + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, riodesc) + ! ncdf_simple_tests.F90.in:132 + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, data_fname, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:134)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:135 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:137)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:138 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:140)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:141 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:143)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:144 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:147)" + END IF + RETURN + END IF + ! ncdf_simple_tests.F90.in:148 + call PIO_syncfile(pio_file) + ! ncdf_simple_tests.F90.in:150 + if (tgv_iotype .eq. PIO_iotype_pnetcdf) then + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "WARNING: Data type conversion not supported in pnetcdf vard interface, skipping test" + END IF + END IF + else + ! Read the variable back (data conversion might occur) + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(data_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:156)" + END IF + RETURN + END IF + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:157)" + END IF + RETURN + END IF + endif + ! ncdf_simple_tests.F90.in:159 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, data_fname); + ! ncdf_simple_tests.F90.in:162 + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + ! ncdf_simple_tests.F90.in:165 +END SUBROUTINE test_data_conversion_PIO_double_real_kind_fc_double___ + ! ncdf_simple_tests.F90.in:166 + + +SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + ! ncdf_simple_tests.F90.in:168 + use ncdf_simple_tests_tgv ! ncdf_simple_tests.F90.in:169 + Implicit none ! ncdf_simple_tests.F90.in:170 + type(file_desc_t) :: pio_file ! ncdf_simple_tests.F90.in:171 + integer :: ret, i ! ncdf_simple_tests.F90.in:172 + ! iotypes = valid NC types + integer, dimension(:), allocatable :: iotypes ! ncdf_simple_tests.F90.in:174 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! ncdf_simple_tests.F90.in:175 + integer :: num_iotypes ! ncdf_simple_tests.F90.in:176 + + + num_iotypes = 0 ! ncdf_simple_tests.F90.in:178 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! ncdf_simple_tests.F90.in:179 + do i=1,num_iotypes ! ncdf_simple_tests.F90.in:180 + tgv_iotype = iotypes(i) ! ncdf_simple_tests.F90.in:181 + ret = PIO_createfile(pio_tf_iosystem_, pio_file, tgv_iotype, tgv_fname) ! ncdf_simple_tests.F90.in:182 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create:"//trim(iotype_descs(i))//":"//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(ncdf_simple_tests.F90.in:183)" + END IF + RETURN + END IF ! ncdf_simple_tests.F90.in:183 + + + call PIO_closefile(pio_file) ! ncdf_simple_tests.F90.in:185 + + + ! Make sure that global variables are set correctly before running the tests + + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Running AUTO tests: ", trim(iotype_descs(i)) + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_data_conversion_PIO_int_integer__"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_data_conversion_PIO_int_integer__" + END IF + CALL test_data_conversion_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_data_conversion_PIO_real_real_kind_fc_real___"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_data_conversion_PIO_real_real_kind_fc_real___" + END IF + CALL test_data_conversion_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_data_conversion_PIO_double_real_kind_fc_double___"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_data_conversion_PIO_double_real_kind_fc_double___" + END IF + CALL test_data_conversion_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_clobber"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_clobber" + END IF + CALL test_clobber() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_redef_enddef"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_redef_enddef" + END IF + CALL test_redef_enddef() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_def_dim"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_def_dim" + END IF + CALL test_def_dim() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="test_def_var"//"("//trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_def_var" + END IF + CALL test_def_var() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + pio_tf_tmp_log_str_,& + "---------","PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + pio_tf_tmp_log_str_,& + "---------","FAILED" + END IF + END IF + ! ncdf_simple_tests.F90.in:188 + + + call PIO_deletefile(pio_tf_iosystem_, tgv_fname) ! ncdf_simple_tests.F90.in:190 + end do ! ncdf_simple_tests.F90.in:191 + if(allocated(iotypes)) then ! ncdf_simple_tests.F90.in:192 + deallocate(iotypes) ! ncdf_simple_tests.F90.in:193 + deallocate(iotype_descs) ! ncdf_simple_tests.F90.in:194 + end if ! ncdf_simple_tests.F90.in:195 + + + +END SUBROUTINE PIO_TF_Test_driver_ ! ncdf_simple_tests.F90.in:197 + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_decomp_fillval.F90.in2 b/tests/general/pio_decomp_fillval.F90.in2 new file mode 100644 index 00000000000..27c9889e42b --- /dev/null +++ b/tests/general/pio_decomp_fillval.F90.in2 @@ -0,0 +1,2709 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_decomp_fillval.F90.in + +! nc write 1d array with fillvalues (the holes are explicitly specified) + + +SUBROUTINE nc_write_1d_explicit_fval_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, rcompdof, compdof_rel_disps + ! Compdof value to suggest that data point is a hole, this hole + ! is usually filled with a fillvalue + integer, parameter :: PIO_COMPDOF_FILLVAL = 0 + integer, dimension(VEC_LOCAL_SZ) :: wbuf, rbuf, exp_val + ! The buffer fillvalue to be used when writing data + integer, PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:24 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:31 + wbuf = wcompdof + exp_val = wcompdof + rbuf = 0 + ! pio_decomp_fillval.F90.in:35 + ! Even indices need to be filled with (BUF_FILLVAL == -2) + do i=1,VEC_LOCAL_SZ,2 + wcompdof(i) = PIO_COMPDOF_FILLVAL + exp_val(i) = BUF_FILLVAL + end do + ! pio_decomp_fillval.F90.in:41 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:44 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + do i=1,num_iotypes + ! pio_decomp_fillval.F90.in:48 + write(filename,'(a,i1)') "test_pio_decomp_fillval_tests.testfile",i + ! pio_decomp_fillval.F90.in:50 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:53)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:54 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:56)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:57 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:59)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:60 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:62)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:63 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:65)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:66 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:69)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:70 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:72 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:74)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:75 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:76)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:77 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:85 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) +END SUBROUTINE nc_write_1d_explicit_fval_PIO_int_integer__ + + +SUBROUTINE nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, rcompdof, compdof_rel_disps + ! Compdof value to suggest that data point is a hole, this hole + ! is usually filled with a fillvalue + integer, parameter :: PIO_COMPDOF_FILLVAL = 0 + real(kind=fc_real), dimension(VEC_LOCAL_SZ) :: wbuf, rbuf, exp_val + ! The buffer fillvalue to be used when writing data + real(kind=fc_real), PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:24 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:31 + wbuf = wcompdof + exp_val = wcompdof + rbuf = 0 + ! pio_decomp_fillval.F90.in:35 + ! Even indices need to be filled with (BUF_FILLVAL == -2) + do i=1,VEC_LOCAL_SZ,2 + wcompdof(i) = PIO_COMPDOF_FILLVAL + exp_val(i) = BUF_FILLVAL + end do + ! pio_decomp_fillval.F90.in:41 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:44 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + do i=1,num_iotypes + ! pio_decomp_fillval.F90.in:48 + write(filename,'(a,i1)') "test_pio_decomp_fillval_tests.testfile",i + ! pio_decomp_fillval.F90.in:50 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:53)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:54 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:56)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:57 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:59)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:60 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:62)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:63 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:65)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:66 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:69)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:70 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:72 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:74)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:75 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:76)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:77 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:85 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) +END SUBROUTINE nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, rcompdof, compdof_rel_disps + ! Compdof value to suggest that data point is a hole, this hole + ! is usually filled with a fillvalue + integer, parameter :: PIO_COMPDOF_FILLVAL = 0 + real(kind=fc_double), dimension(VEC_LOCAL_SZ) :: wbuf, rbuf, exp_val + ! The buffer fillvalue to be used when writing data + real(kind=fc_double), PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:24 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:31 + wbuf = wcompdof + exp_val = wcompdof + rbuf = 0 + ! pio_decomp_fillval.F90.in:35 + ! Even indices need to be filled with (BUF_FILLVAL == -2) + do i=1,VEC_LOCAL_SZ,2 + wcompdof(i) = PIO_COMPDOF_FILLVAL + exp_val(i) = BUF_FILLVAL + end do + ! pio_decomp_fillval.F90.in:41 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:44 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + do i=1,num_iotypes + ! pio_decomp_fillval.F90.in:48 + write(filename,'(a,i1)') "test_pio_decomp_fillval_tests.testfile",i + ! pio_decomp_fillval.F90.in:50 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:53)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:54 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:56)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:57 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:59)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:60 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:62)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:63 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:65)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:66 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:69)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:70 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:72 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:74)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:75 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:76)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:77 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:85 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) +END SUBROUTINE nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___ + ! pio_decomp_fillval.F90.in:88 + + +! nc write 1d array with fillvalues (the holes are implicit) + + +SUBROUTINE nc_write_1d_implicit_fval_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(:), allocatable :: wcompdof + integer :: wcompdof_sz + integer, dimension(VEC_LOCAL_SZ) :: rcompdof, compdof_rel_disps + integer, dimension(:), allocatable :: wbuf + integer, dimension(VEC_LOCAL_SZ) :: rbuf, exp_val + ! The buffer fillvalue to be used when writing data + integer, PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:113 + ! compdof is only specified for valid data values, the data holes are + ! implicitly stated (by not specifying them rather than filling it with 0s) + wcompdof_sz = min(pio_tf_world_rank_+1, VEC_LOCAL_SZ) + allocate(wcompdof(wcompdof_sz)) + allocate(wbuf(wcompdof_sz)) + ! pio_decomp_fillval.F90.in:119 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + ! rank 0 has 1 valid data value, rank 2 has 2 data values and so on... + do i=1,wcompdof_sz + wcompdof(i) = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps(i) + end do + ! Read everything - including fillvalues that should have been + ! written for locations unspecified in wcompdof(:) i.e., + ! wcompdof(wcompdof_sz:VEC_LOCAL_SZ] + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:132 + wbuf = 0 + ! The first wcompdof_sz values, wbuf[1:wcompdof_sz], are valid in wbuf + do i=1,wcompdof_sz + wbuf(i) = wcompdof(i) + exp_val(i) = wbuf(i) + end do + ! We expect the values (wcompdof_sz:VEC_LOCAL_SZ] to be read as + ! user specified fill values + do i=wcompdof_sz+1,VEC_LOCAL_SZ + exp_val(i) = BUF_FILLVAL + end do + rbuf = 0 + ! pio_decomp_fillval.F90.in:145 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:148 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:155)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:156 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:158)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:159 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:161)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:162 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:164)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:165 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:167)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:168 + ! Write the variable out, user specified fillvalue = BUF_FILLVAL + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:171)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:172 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:174 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:176)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:177 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:178)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:179 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:187 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + deallocate(wbuf) + deallocate(wcompdof) +END SUBROUTINE nc_write_1d_implicit_fval_PIO_int_integer__ + + +SUBROUTINE nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(:), allocatable :: wcompdof + integer :: wcompdof_sz + integer, dimension(VEC_LOCAL_SZ) :: rcompdof, compdof_rel_disps + real(kind=fc_real), dimension(:), allocatable :: wbuf + real(kind=fc_real), dimension(VEC_LOCAL_SZ) :: rbuf, exp_val + ! The buffer fillvalue to be used when writing data + real(kind=fc_real), PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:113 + ! compdof is only specified for valid data values, the data holes are + ! implicitly stated (by not specifying them rather than filling it with 0s) + wcompdof_sz = min(pio_tf_world_rank_+1, VEC_LOCAL_SZ) + allocate(wcompdof(wcompdof_sz)) + allocate(wbuf(wcompdof_sz)) + ! pio_decomp_fillval.F90.in:119 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + ! rank 0 has 1 valid data value, rank 2 has 2 data values and so on... + do i=1,wcompdof_sz + wcompdof(i) = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps(i) + end do + ! Read everything - including fillvalues that should have been + ! written for locations unspecified in wcompdof(:) i.e., + ! wcompdof(wcompdof_sz:VEC_LOCAL_SZ] + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:132 + wbuf = 0 + ! The first wcompdof_sz values, wbuf[1:wcompdof_sz], are valid in wbuf + do i=1,wcompdof_sz + wbuf(i) = wcompdof(i) + exp_val(i) = wbuf(i) + end do + ! We expect the values (wcompdof_sz:VEC_LOCAL_SZ] to be read as + ! user specified fill values + do i=wcompdof_sz+1,VEC_LOCAL_SZ + exp_val(i) = BUF_FILLVAL + end do + rbuf = 0 + ! pio_decomp_fillval.F90.in:145 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:148 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:155)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:156 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:158)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:159 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:161)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:162 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:164)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:165 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:167)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:168 + ! Write the variable out, user specified fillvalue = BUF_FILLVAL + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:171)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:172 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:174 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:176)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:177 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:178)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:179 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:187 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + deallocate(wbuf) + deallocate(wcompdof) +END SUBROUTINE nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(:), allocatable :: wcompdof + integer :: wcompdof_sz + integer, dimension(VEC_LOCAL_SZ) :: rcompdof, compdof_rel_disps + real(kind=fc_double), dimension(:), allocatable :: wbuf + real(kind=fc_double), dimension(VEC_LOCAL_SZ) :: rbuf, exp_val + ! The buffer fillvalue to be used when writing data + real(kind=fc_double), PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:113 + ! compdof is only specified for valid data values, the data holes are + ! implicitly stated (by not specifying them rather than filling it with 0s) + wcompdof_sz = min(pio_tf_world_rank_+1, VEC_LOCAL_SZ) + allocate(wcompdof(wcompdof_sz)) + allocate(wbuf(wcompdof_sz)) + ! pio_decomp_fillval.F90.in:119 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + ! rank 0 has 1 valid data value, rank 2 has 2 data values and so on... + do i=1,wcompdof_sz + wcompdof(i) = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps(i) + end do + ! Read everything - including fillvalues that should have been + ! written for locations unspecified in wcompdof(:) i.e., + ! wcompdof(wcompdof_sz:VEC_LOCAL_SZ] + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:132 + wbuf = 0 + ! The first wcompdof_sz values, wbuf[1:wcompdof_sz], are valid in wbuf + do i=1,wcompdof_sz + wbuf(i) = wcompdof(i) + exp_val(i) = wbuf(i) + end do + ! We expect the values (wcompdof_sz:VEC_LOCAL_SZ] to be read as + ! user specified fill values + do i=wcompdof_sz+1,VEC_LOCAL_SZ + exp_val(i) = BUF_FILLVAL + end do + rbuf = 0 + ! pio_decomp_fillval.F90.in:145 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:148 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:155)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:156 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:158)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:159 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:161)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:162 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:164)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:165 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:167)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:168 + ! Write the variable out, user specified fillvalue = BUF_FILLVAL + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:171)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:172 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:174 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:176)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:177 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:178)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:179 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:187 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + deallocate(wbuf) + deallocate(wcompdof) +END SUBROUTINE nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___ + ! pio_decomp_fillval.F90.in:192 + + +! nc read 1d array with fillvalues (the holes are explicitly specified) + + +SUBROUTINE nc_read_1d_explicit_fval_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, rcompdof, compdof_rel_disps + ! Compdof value to suggest that data point is a hole + integer, parameter :: PIO_COMPDOF_FILLVAL = 0 + integer, dimension(VEC_LOCAL_SZ) :: wbuf, rbuf, exp_val + ! The buffer fillvalue used to initialize data + integer, PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:216 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:223 + wbuf = wcompdof + exp_val = wcompdof + rbuf = BUF_FILLVAL + ! pio_decomp_fillval.F90.in:227 + ! We don't want to read even indices (BUF_FILLVAL == -2) + do i=1,VEC_LOCAL_SZ,2 + rcompdof(i) = PIO_COMPDOF_FILLVAL + exp_val(i) = BUF_FILLVAL + end do + ! pio_decomp_fillval.F90.in:233 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:236 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + ! pio_decomp_fillval.F90.in:239 + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:244)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:245 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:247)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:248 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:250)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:251 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:253)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:254 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:256)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:257 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:260)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:261 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:263 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:265)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:266 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:267)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:268 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:276 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) +END SUBROUTINE nc_read_1d_explicit_fval_PIO_int_integer__ + + +SUBROUTINE nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, rcompdof, compdof_rel_disps + ! Compdof value to suggest that data point is a hole + integer, parameter :: PIO_COMPDOF_FILLVAL = 0 + real(kind=fc_real), dimension(VEC_LOCAL_SZ) :: wbuf, rbuf, exp_val + ! The buffer fillvalue used to initialize data + real(kind=fc_real), PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:216 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:223 + wbuf = wcompdof + exp_val = wcompdof + rbuf = BUF_FILLVAL + ! pio_decomp_fillval.F90.in:227 + ! We don't want to read even indices (BUF_FILLVAL == -2) + do i=1,VEC_LOCAL_SZ,2 + rcompdof(i) = PIO_COMPDOF_FILLVAL + exp_val(i) = BUF_FILLVAL + end do + ! pio_decomp_fillval.F90.in:233 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:236 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + ! pio_decomp_fillval.F90.in:239 + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:244)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:245 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:247)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:248 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:250)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:251 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:253)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:254 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:256)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:257 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:260)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:261 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:263 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:265)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:266 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:267)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:268 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:276 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) +END SUBROUTINE nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, rcompdof, compdof_rel_disps + ! Compdof value to suggest that data point is a hole + integer, parameter :: PIO_COMPDOF_FILLVAL = 0 + real(kind=fc_double), dimension(VEC_LOCAL_SZ) :: wbuf, rbuf, exp_val + ! The buffer fillvalue used to initialize data + real(kind=fc_double), PARAMETER :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:216 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + rcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + ! pio_decomp_fillval.F90.in:223 + wbuf = wcompdof + exp_val = wcompdof + rbuf = BUF_FILLVAL + ! pio_decomp_fillval.F90.in:227 + ! We don't want to read even indices (BUF_FILLVAL == -2) + do i=1,VEC_LOCAL_SZ,2 + rcompdof(i) = PIO_COMPDOF_FILLVAL + exp_val(i) = BUF_FILLVAL + end do + ! pio_decomp_fillval.F90.in:233 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:236 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + ! pio_decomp_fillval.F90.in:239 + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:244)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:245 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:247)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:248 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:250)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:251 + ierr = PIO_put_att(pio_file, pio_var, '_FillValue', BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define fill value : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:253)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:254 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:256)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:257 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr, BUF_FILLVAL) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:260)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:261 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:263 + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:265)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:266 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:267)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:268 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:276 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) +END SUBROUTINE nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___ + ! pio_decomp_fillval.F90.in:279 + + +! nc read 1d array with fillvalues (the holes are implicit) + + +SUBROUTINE nc_read_1d_implicit_fval_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(:), allocatable :: rcompdof + integer :: rcompdof_sz + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, compdof_rel_disps + integer, dimension(:), allocatable :: rbuf, exp_val + integer, dimension(VEC_LOCAL_SZ) :: wbuf + integer, parameter :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:303 + ! compdof is only specified for valid data values, the data holes are + ! implicitly stated (by not specifying them rather than filling it with 0s) + rcompdof_sz = min(pio_tf_world_rank_+1, VEC_LOCAL_SZ) + allocate(rcompdof(rcompdof_sz)) + allocate(rbuf(rcompdof_sz)) + allocate(exp_val(rcompdof_sz)) + ! pio_decomp_fillval.F90.in:310 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + ! We only read 1 value on rank0, 2 values on rank1, ... + do i=1,rcompdof_sz + rcompdof(i) = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps(i) + end do + ! Write everything - we only read some of these values + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wbuf = wcompdof + ! pio_decomp_fillval.F90.in:322 + rbuf = BUF_FILLVAL + do i=1,rcompdof_sz + exp_val(i) = wbuf(i) + end do + ! pio_decomp_fillval.F90.in:327 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:330 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:337)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:338 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:340)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:341 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:343)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:344 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:346)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:347 + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:349)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:350 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:352 + ! Read only part of the written data + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:355)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:356 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:357)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:358 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:366 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(rcompdof) +END SUBROUTINE nc_read_1d_implicit_fval_PIO_int_integer__ + + +SUBROUTINE nc_read_1d_implicit_fval_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(:), allocatable :: rcompdof + integer :: rcompdof_sz + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, compdof_rel_disps + real(kind=fc_real), dimension(:), allocatable :: rbuf, exp_val + real(kind=fc_real), dimension(VEC_LOCAL_SZ) :: wbuf + integer, parameter :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:303 + ! compdof is only specified for valid data values, the data holes are + ! implicitly stated (by not specifying them rather than filling it with 0s) + rcompdof_sz = min(pio_tf_world_rank_+1, VEC_LOCAL_SZ) + allocate(rcompdof(rcompdof_sz)) + allocate(rbuf(rcompdof_sz)) + allocate(exp_val(rcompdof_sz)) + ! pio_decomp_fillval.F90.in:310 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + ! We only read 1 value on rank0, 2 values on rank1, ... + do i=1,rcompdof_sz + rcompdof(i) = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps(i) + end do + ! Write everything - we only read some of these values + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wbuf = wcompdof + ! pio_decomp_fillval.F90.in:322 + rbuf = BUF_FILLVAL + do i=1,rcompdof_sz + exp_val(i) = wbuf(i) + end do + ! pio_decomp_fillval.F90.in:327 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:330 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:337)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:338 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:340)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:341 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:343)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:344 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:346)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:347 + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:349)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:350 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:352 + ! Read only part of the written data + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:355)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:356 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:357)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:358 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:366 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(rcompdof) +END SUBROUTINE nc_read_1d_implicit_fval_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_read_1d_implicit_fval_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wiodesc, riodesc + integer, dimension(:), allocatable :: rcompdof + integer :: rcompdof_sz + integer, dimension(VEC_LOCAL_SZ) :: wcompdof, compdof_rel_disps + real(kind=fc_double), dimension(:), allocatable :: rbuf, exp_val + real(kind=fc_double), dimension(VEC_LOCAL_SZ) :: wbuf + integer, parameter :: BUF_FILLVAL = -2 + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_fillval.F90.in:303 + ! compdof is only specified for valid data values, the data holes are + ! implicitly stated (by not specifying them rather than filling it with 0s) + rcompdof_sz = min(pio_tf_world_rank_+1, VEC_LOCAL_SZ) + allocate(rcompdof(rcompdof_sz)) + allocate(rbuf(rcompdof_sz)) + allocate(exp_val(rcompdof_sz)) + ! pio_decomp_fillval.F90.in:310 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + ! We only read 1 value on rank0, 2 values on rank1, ... + do i=1,rcompdof_sz + rcompdof(i) = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps(i) + end do + ! Write everything - we only read some of these values + wcompdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + wbuf = wcompdof + ! pio_decomp_fillval.F90.in:322 + rbuf = BUF_FILLVAL + do i=1,rcompdof_sz + exp_val(i) = wbuf(i) + end do + ! pio_decomp_fillval.F90.in:327 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, wcompdof, wiodesc) + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, rcompdof, riodesc) + ! pio_decomp_fillval.F90.in:330 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_fillval_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:337)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:338 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:340)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:341 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:343)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:344 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:346)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:347 + call PIO_write_darray(pio_file, pio_var, wiodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:349)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:350 + call PIO_syncfile(pio_file) + ! pio_decomp_fillval.F90.in:352 + ! Read only part of the written data + call PIO_read_darray(pio_file, pio_var, riodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:355)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:356 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_fillval.F90.in:357)" + END IF + RETURN + END IF + ! pio_decomp_fillval.F90.in:358 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename) + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_fillval.F90.in:366 + call PIO_freedecomp(pio_tf_iosystem_, riodesc) + call PIO_freedecomp(pio_tf_iosystem_, wiodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(rcompdof) +END SUBROUTINE nc_read_1d_implicit_fval_PIO_double_real_kind_fc_double___ + ! pio_decomp_fillval.F90.in:372 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_int_integer__" + END IF + CALL nc_write_1d_explicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_1d_explicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_1d_explicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_int_integer__" + END IF + CALL nc_write_1d_explicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_write_1d_explicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_write_1d_explicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_int_integer__" + END IF + CALL nc_write_1d_implicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_write_1d_implicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_write_1d_implicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_int_integer__" + END IF + CALL nc_write_1d_explicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "nc_write_1d_explicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "nc_write_1d_explicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_int_integer__" + END IF + CALL nc_write_1d_implicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "nc_write_1d_implicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "nc_write_1d_implicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_explicit_fval_PIO_int_integer__" + END IF + CALL nc_read_1d_explicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "nc_read_1d_explicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "nc_read_1d_explicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_int_integer__" + END IF + CALL nc_write_1d_explicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 19:",& + "nc_write_1d_explicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 19:",& + "nc_write_1d_explicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 20:",& + "nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 20:",& + "nc_write_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 21:",& + "nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 21:",& + "nc_write_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_int_integer__" + END IF + CALL nc_write_1d_implicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 22:",& + "nc_write_1d_implicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 22:",& + "nc_write_1d_implicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 23:",& + "nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 23:",& + "nc_write_1d_implicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 24:",& + "nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 24:",& + "nc_write_1d_implicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_explicit_fval_PIO_int_integer__" + END IF + CALL nc_read_1d_explicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 25:",& + "nc_read_1d_explicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 25:",& + "nc_read_1d_explicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 26:",& + "nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 26:",& + "nc_read_1d_explicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 27:",& + "nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 27:",& + "nc_read_1d_explicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_implicit_fval_PIO_int_integer__" + END IF + CALL nc_read_1d_implicit_fval_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 28:",& + "nc_read_1d_implicit_fval_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 28:",& + "nc_read_1d_implicit_fval_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_implicit_fval_PIO_real_real_kind_fc_real___" + END IF + CALL nc_read_1d_implicit_fval_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 29:",& + "nc_read_1d_implicit_fval_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 29:",& + "nc_read_1d_implicit_fval_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_read_1d_implicit_fval_PIO_double_real_kind_fc_double___" + END IF + CALL nc_read_1d_implicit_fval_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 30:",& + "nc_read_1d_implicit_fval_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 30:",& + "nc_read_1d_implicit_fval_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_decomp_frame_tests.F90.in2 b/tests/general/pio_decomp_frame_tests.F90.in2 new file mode 100644 index 00000000000..d605b948dfc --- /dev/null +++ b/tests/general/pio_decomp_frame_tests.F90.in2 @@ -0,0 +1,2935 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_decomp_frame_tests.F90.in + +! Get a 3D column decomposition +! If force_rearrange is FALSE, the decomposition is such that +! # All even procs have VEC_HGT_SZ blocks of +! (VEC_COL_SZ rows x VEC_ROW_SZ columns) elements +! # All odd procs have VEC_HGT_SZ blocks of +! (VEC_COL_SZ rows x VEC_ROW_SZ + 1 columns) elements +! e.g. For VEC_ROW_SZ = 2, VEC_COL_SZ = 2, VEC_HGT_SZ = 2 +! and ranks 0, 1, 2, +! e.g. 1) |(1,1,1) (1,2,1) (2,1,1) (2,2,1)| +! |(1,1,2) (1,2,2) (2,1,2) (2,2,2)| , +! |(1,3,1) (1,4,1) (1,5,1) (2,3,1) (2,4,1) (2,5,1)| +! |(1,3,2) (1,4,2) (1,5,2) (2,3,2) (2,4,2) (2,5,2)|, +! |(1,6,1) (1,7,1) (2,6,1) (2,7,1)| +! |(1,6,2) (1,7,2) (2,6,2) (2,7,2)| +! If force_rearrange is TRUE, the decomposition is such that, +! If possible, the even rank "exchanges" elements with the next +! higher ranked odd proc. +! e.g. For VEC_ROW_SZ = 2, VEC_COL_SZ = 2, VEC_HGT_SZ = 2 +! and ranks 0, 1, 2, +! e.g. 1 |(1,3,1) (1,4,1) (1,5,1) (2,3,1) (2,4,1) (2,5,1)| +! |(1,3,2) (1,4,2) (1,5,2) (2,3,2) (2,4,2) (2,5,2)|, +! |(1,1,1) (1,2,1) (2,1,1) (2,2,1)| +! |(1,1,2) (1,2,2) (2,1,2) (2,2,2)| , +! |(1,6,1) (1,7,1) (2,6,1) (2,7,1)| +! |(1,6,2) (1,7,2) (2,6,2) (2,7,2)| +! This for example can be used to force rearrangement when reading +! or writing data. +SUBROUTINE get_3d_col_decomp_info(rank, sz, dims, start, count, force_rearrange) ! pio_decomp_frame_tests.F90.in:28 + integer, parameter :: VEC_ROW_SZ = 2 ! pio_decomp_frame_tests.F90.in:29 + integer, parameter :: VEC_COL_SZ = 2 ! pio_decomp_frame_tests.F90.in:30 + integer, parameter :: VEC_HGT_SZ = 2 ! pio_decomp_frame_tests.F90.in:31 + integer, parameter :: NDIMS = 3 ! pio_decomp_frame_tests.F90.in:32 + integer, intent(in) :: rank ! pio_decomp_frame_tests.F90.in:33 + integer, intent(in) :: sz ! pio_decomp_frame_tests.F90.in:34 + integer, dimension(NDIMS), intent(out) :: dims ! pio_decomp_frame_tests.F90.in:35 + integer, dimension(NDIMS), intent(out) :: start ! pio_decomp_frame_tests.F90.in:36 + integer, dimension(NDIMS), intent(out) :: count ! pio_decomp_frame_tests.F90.in:37 + logical, intent(in) :: force_rearrange ! pio_decomp_frame_tests.F90.in:38 + + + logical :: is_even_rank ! pio_decomp_frame_tests.F90.in:40 + integer :: num_odd_procs, num_even_procs ! pio_decomp_frame_tests.F90.in:41 + integer :: iodd, ieven ! pio_decomp_frame_tests.F90.in:42 + + + is_even_rank = .false. ! pio_decomp_frame_tests.F90.in:44 + if (mod(rank, 2) == 0) then ! pio_decomp_frame_tests.F90.in:45 + is_even_rank = .true. ! pio_decomp_frame_tests.F90.in:46 + end if ! pio_decomp_frame_tests.F90.in:47 + num_odd_procs = sz / 2 ! pio_decomp_frame_tests.F90.in:48 + num_even_procs = sz - num_odd_procs ! pio_decomp_frame_tests.F90.in:49 + dims(1) = VEC_COL_SZ ! pio_decomp_frame_tests.F90.in:50 + dims(2) = num_even_procs * VEC_ROW_SZ + num_odd_procs * (VEC_ROW_SZ + 1) ! pio_decomp_frame_tests.F90.in:51 + dims(3) = VEC_HGT_SZ ! pio_decomp_frame_tests.F90.in:52 + ! Number of odd and even procs before this rank + iodd = rank / 2 ! pio_decomp_frame_tests.F90.in:54 + ieven = (rank + 1) / 2 ! pio_decomp_frame_tests.F90.in:55 + + + ! Rows + start(1) = 1 ! pio_decomp_frame_tests.F90.in:58 + count(1) = VEC_COL_SZ ! pio_decomp_frame_tests.F90.in:59 + + + ! Columns + if(force_rearrange) then ! pio_decomp_frame_tests.F90.in:62 + ! Make sure that we force rearrangement + if (is_even_rank) then ! pio_decomp_frame_tests.F90.in:64 + if(rank + 1 < sz) then ! pio_decomp_frame_tests.F90.in:65 + ! Force rearrangement + count(2) = VEC_ROW_SZ + 1 ! pio_decomp_frame_tests.F90.in:67 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + (VEC_ROW_SZ) + 1 ! pio_decomp_frame_tests.F90.in:68 + else ! pio_decomp_frame_tests.F90.in:69 + count(2) = VEC_ROW_SZ ! pio_decomp_frame_tests.F90.in:70 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + 1 ! pio_decomp_frame_tests.F90.in:71 + end if ! pio_decomp_frame_tests.F90.in:72 + else ! pio_decomp_frame_tests.F90.in:73 + ! For all odd procs there is an even lower ranked, rank-1, proc + ! So force rearrangement + count(2) = VEC_ROW_SZ ! pio_decomp_frame_tests.F90.in:76 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) - (VEC_ROW_SZ) + 1 ! pio_decomp_frame_tests.F90.in:77 + end if ! pio_decomp_frame_tests.F90.in:78 + else ! pio_decomp_frame_tests.F90.in:79 + if (is_even_rank) then ! pio_decomp_frame_tests.F90.in:80 + count(2) = VEC_ROW_SZ ! pio_decomp_frame_tests.F90.in:81 + else ! pio_decomp_frame_tests.F90.in:82 + count(2) = VEC_ROW_SZ + 1 ! pio_decomp_frame_tests.F90.in:83 + end if ! pio_decomp_frame_tests.F90.in:84 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + 1 ! pio_decomp_frame_tests.F90.in:85 + end if ! pio_decomp_frame_tests.F90.in:86 + + + ! Height + start(3) = 1 ! pio_decomp_frame_tests.F90.in:89 + count(3) = VEC_HGT_SZ ! pio_decomp_frame_tests.F90.in:90 +END SUBROUTINE ! pio_decomp_frame_tests.F90.in:91 + + +! Write with one decomp (to force rearrangement) and read with another (no +! rearrangement) + + +SUBROUTINE nc_write_read_4d_col_decomp_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 6 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + integer, dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:115 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf(i,j,k,f) = wbuf(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k,1) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:137 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:140 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts, NFRAMES)) + ! pio_decomp_frame_tests.F90.in:150 + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k,f) = compdof(tmp_idx) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:163 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:166 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:173)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:174 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:176)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:177 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:179)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:180 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:182)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:183 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time', pio_unlimited, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:185)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:186 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:188)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:189 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:191)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:192 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:197)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:199 + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:201 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:205)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:207 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf(:,:,:,f), exp_val(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:209)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:211 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:216 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:221 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_4d_col_decomp_PIO_int_integer__ + + +SUBROUTINE nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 6 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_real), dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:115 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf(i,j,k,f) = wbuf(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k,1) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:137 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:140 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts, NFRAMES)) + ! pio_decomp_frame_tests.F90.in:150 + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k,f) = compdof(tmp_idx) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:163 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:166 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:173)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:174 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:176)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:177 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:179)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:180 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:182)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:183 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time', pio_unlimited, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:185)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:186 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:188)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:189 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:191)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:192 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:197)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:199 + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:201 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:205)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:207 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf(:,:,:,f), exp_val(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:209)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:211 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:216 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:221 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 6 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_double), dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:115 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf(i,j,k,f) = wbuf(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k,1) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:137 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:140 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts, NFRAMES)) + ! pio_decomp_frame_tests.F90.in:150 + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k,f) = compdof(tmp_idx) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:163 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:166 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:173)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:174 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:176)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:177 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:179)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:180 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:182)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:183 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time', pio_unlimited, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:185)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:186 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:188)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:189 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:191)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:192 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:197)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:199 + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:201 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:205)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:207 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf(:,:,:,f), exp_val(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:209)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:211 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:216 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:221 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___ + ! pio_decomp_frame_tests.F90.in:227 + + +! Using a 3d decomp for writing out a 3d and a 4d var +! Write with one decomp (to force rearrangement) and read with another (no +! rearrangement) + + +SUBROUTINE nc_reuse_3d_decomp_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 3 + type(var_desc_t) :: pio_var3d, pio_var4d + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + integer, dimension(:,:,:,:), allocatable :: rbuf4d, wbuf4d, exp_val4d + integer, dimension(:,:,:), allocatable :: rbuf3d, wbuf3d, exp_val3d + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:253 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + ! Initialize the 4d var + allocate(wbuf4d(nrows, ncols, nhgts, NFRAMES)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf4d(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf4d(i,j,k,f) = wbuf4d(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf4d(i,j,k,1) + end do + end do + end do + ! Initialize the 3d var + allocate(wbuf3d(nrows, ncols, nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf3d(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:292 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:295 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf4d(nrows, ncols, nhgts, NFRAMES)) + rbuf4d = 0 + ! Expected val for 4d var + allocate(exp_val4d(nrows, ncols, nhgts, NFRAMES)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + exp_val4d(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val4d(i,j,k,f) = exp_val4d(i,j,k,f)+(f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = exp_val4d(i,j,k,1) + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:326 + allocate(rbuf3d(nrows, ncols, nhgts)) + rbuf3d = 0 + ! Expected val for 3d var + allocate(exp_val3d(nrows, ncols, nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + exp_val3d(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:339 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:342 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:349)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:350 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:352)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:353 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:355)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:356 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:358)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:359 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time', pio_unlimited, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:361)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:362 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_3d_var', PIO_int, pio_dims(1:3), pio_var3d) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a 3d var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:364)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:365 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_4d_var', PIO_int, pio_dims, pio_var4d) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a 4d var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:367)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:368 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:370)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:371 + call PIO_write_darray(pio_file, pio_var3d, wr_iodesc, wbuf3d, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write 3d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:373)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:374 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var4d, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var4d, wr_iodesc, wbuf4d(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write 4d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:379)" + END IF + RETURN + END IF + end do + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:382 + rbuf4d = 0 + rbuf3d = 0 + ! pio_decomp_frame_tests.F90.in:385 + call PIO_read_darray(pio_file, pio_var3d, rd_iodesc, rbuf3d, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read 3d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:387)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:388 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var4d, f) + call PIO_read_darray(pio_file, pio_var4d, rd_iodesc, rbuf4d(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read 4d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:392)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:394 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf4d(:,:,:,f), exp_val4d(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong 4d val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:396)" + END IF + RETURN + END IF + end do + + IF (.NOT. PIO_TF_Check_val_(rbuf3d, exp_val3d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong 3dd val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:398)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:399 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:404 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:409 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + ! pio_decomp_frame_tests.F90.in:412 + deallocate(exp_val3d) + deallocate(rbuf3d) + deallocate(wbuf3d) + ! pio_decomp_frame_tests.F90.in:416 + deallocate(exp_val4d) + deallocate(rbuf4d) + deallocate(wbuf4d) +END SUBROUTINE nc_reuse_3d_decomp_PIO_int_integer__ + + +SUBROUTINE nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 3 + type(var_desc_t) :: pio_var3d, pio_var4d + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_real), dimension(:,:,:,:), allocatable :: rbuf4d, wbuf4d, exp_val4d + real(kind=fc_real), dimension(:,:,:), allocatable :: rbuf3d, wbuf3d, exp_val3d + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:253 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + ! Initialize the 4d var + allocate(wbuf4d(nrows, ncols, nhgts, NFRAMES)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf4d(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf4d(i,j,k,f) = wbuf4d(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf4d(i,j,k,1) + end do + end do + end do + ! Initialize the 3d var + allocate(wbuf3d(nrows, ncols, nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf3d(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:292 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:295 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf4d(nrows, ncols, nhgts, NFRAMES)) + rbuf4d = 0 + ! Expected val for 4d var + allocate(exp_val4d(nrows, ncols, nhgts, NFRAMES)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + exp_val4d(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val4d(i,j,k,f) = exp_val4d(i,j,k,f)+(f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = exp_val4d(i,j,k,1) + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:326 + allocate(rbuf3d(nrows, ncols, nhgts)) + rbuf3d = 0 + ! Expected val for 3d var + allocate(exp_val3d(nrows, ncols, nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + exp_val3d(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:339 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:342 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:349)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:350 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:352)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:353 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:355)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:356 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:358)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:359 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time', pio_unlimited, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:361)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:362 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_3d_var', PIO_real, pio_dims(1:3), pio_var3d) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a 3d var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:364)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:365 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_4d_var', PIO_real, pio_dims, pio_var4d) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a 4d var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:367)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:368 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:370)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:371 + call PIO_write_darray(pio_file, pio_var3d, wr_iodesc, wbuf3d, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write 3d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:373)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:374 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var4d, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var4d, wr_iodesc, wbuf4d(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write 4d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:379)" + END IF + RETURN + END IF + end do + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:382 + rbuf4d = 0 + rbuf3d = 0 + ! pio_decomp_frame_tests.F90.in:385 + call PIO_read_darray(pio_file, pio_var3d, rd_iodesc, rbuf3d, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read 3d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:387)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:388 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var4d, f) + call PIO_read_darray(pio_file, pio_var4d, rd_iodesc, rbuf4d(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read 4d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:392)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:394 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf4d(:,:,:,f), exp_val4d(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong 4d val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:396)" + END IF + RETURN + END IF + end do + + IF (.NOT. PIO_TF_Check_val_(rbuf3d, exp_val3d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong 3dd val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:398)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:399 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:404 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:409 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + ! pio_decomp_frame_tests.F90.in:412 + deallocate(exp_val3d) + deallocate(rbuf3d) + deallocate(wbuf3d) + ! pio_decomp_frame_tests.F90.in:416 + deallocate(exp_val4d) + deallocate(rbuf4d) + deallocate(wbuf4d) +END SUBROUTINE nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 3 + type(var_desc_t) :: pio_var3d, pio_var4d + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_double), dimension(:,:,:,:), allocatable :: rbuf4d, wbuf4d, exp_val4d + real(kind=fc_double), dimension(:,:,:), allocatable :: rbuf3d, wbuf3d, exp_val3d + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:253 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + ! Initialize the 4d var + allocate(wbuf4d(nrows, ncols, nhgts, NFRAMES)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf4d(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf4d(i,j,k,f) = wbuf4d(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf4d(i,j,k,1) + end do + end do + end do + ! Initialize the 3d var + allocate(wbuf3d(nrows, ncols, nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf3d(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:292 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:295 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf4d(nrows, ncols, nhgts, NFRAMES)) + rbuf4d = 0 + ! Expected val for 4d var + allocate(exp_val4d(nrows, ncols, nhgts, NFRAMES)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + exp_val4d(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val4d(i,j,k,f) = exp_val4d(i,j,k,f)+(f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = exp_val4d(i,j,k,1) + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:326 + allocate(rbuf3d(nrows, ncols, nhgts)) + rbuf3d = 0 + ! Expected val for 3d var + allocate(exp_val3d(nrows, ncols, nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + exp_val3d(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:339 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:342 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:349)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:350 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:352)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:353 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:355)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:356 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:358)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:359 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time', pio_unlimited, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:361)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:362 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_3d_var', PIO_double, pio_dims(1:3), pio_var3d) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a 3d var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:364)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:365 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_4d_var', PIO_double, pio_dims, pio_var4d) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a 4d var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:367)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:368 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:370)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:371 + call PIO_write_darray(pio_file, pio_var3d, wr_iodesc, wbuf3d, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write 3d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:373)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:374 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var4d, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var4d, wr_iodesc, wbuf4d(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write 4d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:379)" + END IF + RETURN + END IF + end do + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:382 + rbuf4d = 0 + rbuf3d = 0 + ! pio_decomp_frame_tests.F90.in:385 + call PIO_read_darray(pio_file, pio_var3d, rd_iodesc, rbuf3d, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read 3d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:387)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:388 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var4d, f) + call PIO_read_darray(pio_file, pio_var4d, rd_iodesc, rbuf4d(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read 4d darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:392)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:394 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf4d(:,:,:,f), exp_val4d(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong 4d val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:396)" + END IF + RETURN + END IF + end do + + IF (.NOT. PIO_TF_Check_val_(rbuf3d, exp_val3d)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong 3dd val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:398)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:399 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:404 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:409 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + ! pio_decomp_frame_tests.F90.in:412 + deallocate(exp_val3d) + deallocate(rbuf3d) + deallocate(wbuf3d) + ! pio_decomp_frame_tests.F90.in:416 + deallocate(exp_val4d) + deallocate(rbuf4d) + deallocate(wbuf4d) +END SUBROUTINE nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___ + ! pio_decomp_frame_tests.F90.in:420 + + +! Same as nc_write_read_4d_col_decomp, but use a limited time dimension instead + + +SUBROUTINE nc_test_limited_time_dim_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 6 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + integer, dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:443 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf(i,j,k,f) = wbuf(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k,1) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:465 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:468 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts, NFRAMES)) + ! pio_decomp_frame_tests.F90.in:478 + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k,f) = compdof(tmp_idx) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:491 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:494 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:501)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:502 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:504)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:505 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:507)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:508 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:510)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:511 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time_limited', NFRAMES, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:513)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:514 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:516)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:517 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:519)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:520 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:525)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:527 + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:529 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:533)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:535 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf(:,:,:,f), exp_val(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:537)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:539 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:544 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:549 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_test_limited_time_dim_PIO_int_integer__ + + +SUBROUTINE nc_test_limited_time_dim_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 6 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_real), dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:443 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf(i,j,k,f) = wbuf(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k,1) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:465 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:468 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts, NFRAMES)) + ! pio_decomp_frame_tests.F90.in:478 + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k,f) = compdof(tmp_idx) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:491 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:494 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:501)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:502 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:504)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:505 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:507)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:508 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:510)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:511 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time_limited', NFRAMES, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:513)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:514 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:516)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:517 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:519)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:520 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:525)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:527 + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:529 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:533)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:535 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf(:,:,:,f), exp_val(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:537)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:539 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:544 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:549 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_test_limited_time_dim_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_test_limited_time_dim_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: NDIMS = 4 + integer, parameter :: NFRAMES = 6 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_double), dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS-1) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + integer(kind=pio_offset_kind) :: f + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_frame_tests.F90.in:443 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + wbuf(i,j,k,f) = wbuf(i,j,k,f) + (f - 1) * (dims(1) * dims(2) * dims(3)) + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k,1) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:465 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:468 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts, NFRAMES)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts, NFRAMES)) + ! pio_decomp_frame_tests.F90.in:478 + do f=1,NFRAMES + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k,f) = compdof(tmp_idx) + (f - 1) * (dims(1) * dims(2) * dims(3)) + end do + end do + end do + end do + ! pio_decomp_frame_tests.F90.in:491 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_frame_tests.F90.in:494 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:501)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:502 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:504)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:505 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:507)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:508 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:510)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:511 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time_limited', NFRAMES, pio_dims(4)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:513)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:514 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:516)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:517 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:519)" + END IF + RETURN + END IF + ! pio_decomp_frame_tests.F90.in:520 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + ! Write the current frame + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:525)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:527 + call PIO_syncfile(pio_file) + ! pio_decomp_frame_tests.F90.in:529 + do f=1,NFRAMES + call PIO_setframe(pio_file, pio_var, f) + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf(:,:,:,f), ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:533)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:535 + do f=1,NFRAMES + + IF (.NOT. PIO_TF_Check_val_(rbuf(:,:,:,f), exp_val(:,:,:,f))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val, frame=", f,& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_frame_tests.F90.in:537)" + END IF + RETURN + END IF + end do + ! pio_decomp_frame_tests.F90.in:539 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_frame_tests.F90.in:544 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_frame_tests.F90.in:549 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_test_limited_time_dim_PIO_double_real_kind_fc_double___ + ! pio_decomp_frame_tests.F90.in:555 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_int_integer__" + END IF + CALL nc_write_read_4d_col_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_read_4d_col_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_read_4d_col_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_int_integer__" + END IF + CALL nc_write_read_4d_col_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_write_read_4d_col_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_write_read_4d_col_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_reuse_3d_decomp_PIO_int_integer__" + END IF + CALL nc_reuse_3d_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_reuse_3d_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_reuse_3d_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_int_integer__" + END IF + CALL nc_write_read_4d_col_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "nc_write_read_4d_col_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "nc_write_read_4d_col_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "nc_write_read_4d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_reuse_3d_decomp_PIO_int_integer__" + END IF + CALL nc_reuse_3d_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "nc_reuse_3d_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "nc_reuse_3d_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "nc_reuse_3d_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "nc_reuse_3d_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_test_limited_time_dim_PIO_int_integer__" + END IF + CALL nc_test_limited_time_dim_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "nc_test_limited_time_dim_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "nc_test_limited_time_dim_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_test_limited_time_dim_PIO_real_real_kind_fc_real___" + END IF + CALL nc_test_limited_time_dim_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "nc_test_limited_time_dim_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "nc_test_limited_time_dim_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_test_limited_time_dim_PIO_double_real_kind_fc_double___" + END IF + CALL nc_test_limited_time_dim_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "nc_test_limited_time_dim_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "nc_test_limited_time_dim_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_decomp_tests.F90.in2 b/tests/general/pio_decomp_tests.F90.in2 new file mode 100644 index 00000000000..de2595a4b31 --- /dev/null +++ b/tests/general/pio_decomp_tests.F90.in2 @@ -0,0 +1,2210 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_decomp_tests.F90.in + +SUBROUTINE init_decomp_1d_get_loc_sz + USE pio_tutil + ! pio_decomp_tests.F90.in:1 + implicit none ! pio_decomp_tests.F90.in:2 + integer, parameter :: VEC_LOCAL_SZ = 7 ! pio_decomp_tests.F90.in:3 + integer, dimension(:), allocatable :: data_types ! pio_decomp_tests.F90.in:4 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: data_type_descs ! pio_decomp_tests.F90.in:5 + type(io_desc_t) :: iodesc ! pio_decomp_tests.F90.in:6 + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps ! pio_decomp_tests.F90.in:7 + integer, dimension(1) :: dims ! pio_decomp_tests.F90.in:8 + integer :: i, ntypes, lsz ! pio_decomp_tests.F90.in:9 + + + do i=1,VEC_LOCAL_SZ ! pio_decomp_tests.F90.in:11 + compdof_rel_disps(i) = i ! pio_decomp_tests.F90.in:12 + end do ! pio_decomp_tests.F90.in:13 + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ ! pio_decomp_tests.F90.in:14 + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps ! pio_decomp_tests.F90.in:15 + + + call PIO_TF_Get_data_types(data_types, data_type_descs, ntypes) ! pio_decomp_tests.F90.in:17 + do i=1,ntypes ! pio_decomp_tests.F90.in:18 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing type : ", data_type_descs(i) + END IF + END IF ! pio_decomp_tests.F90.in:19 + call PIO_initdecomp(pio_tf_iosystem_, data_types(i), dims, compdof, iodesc) ! pio_decomp_tests.F90.in:20 + lsz = PIO_get_local_array_size(iodesc) ! pio_decomp_tests.F90.in:21 + + IF (.NOT. (PIO_TF_Passert_(lsz == VEC_LOCAL_SZ, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Checking the local array size",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:22)" + END IF + RETURN + END IF ! pio_decomp_tests.F90.in:22 + call PIO_freedecomp(pio_tf_iosystem_, iodesc) ! pio_decomp_tests.F90.in:23 + end do ! pio_decomp_tests.F90.in:24 + + + if(allocated(data_types)) then ! pio_decomp_tests.F90.in:26 + deallocate(data_types) ! pio_decomp_tests.F90.in:27 + deallocate(data_type_descs) ! pio_decomp_tests.F90.in:28 + end if ! pio_decomp_tests.F90.in:29 +END SUBROUTINE init_decomp_1d_get_loc_sz ! pio_decomp_tests.F90.in:30 + + + + +SUBROUTINE nc_write_1d_darray_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: iodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + integer, dimension(VEC_LOCAL_SZ) :: buf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests.F90.in:49 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + buf = pio_tf_world_rank_; + ! pio_decomp_tests.F90.in:56 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:58 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:65)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:66 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:68)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:69 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:71)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:72 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:74)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:75 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:78)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:79 + ! FIXME: Verify the written output + ! pio_decomp_tests.F90.in:81 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests.F90.in:89 + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_write_1d_darray_PIO_int_integer__ + + +SUBROUTINE nc_write_1d_darray_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: iodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + real(kind=fc_real), dimension(VEC_LOCAL_SZ) :: buf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests.F90.in:49 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + buf = pio_tf_world_rank_; + ! pio_decomp_tests.F90.in:56 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:58 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:65)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:66 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:68)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:69 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:71)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:72 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:74)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:75 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:78)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:79 + ! FIXME: Verify the written output + ! pio_decomp_tests.F90.in:81 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests.F90.in:89 + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_write_1d_darray_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_write_1d_darray_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: iodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + real(kind=fc_double), dimension(VEC_LOCAL_SZ) :: buf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests.F90.in:49 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + buf = pio_tf_world_rank_; + ! pio_decomp_tests.F90.in:56 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:58 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:65)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:66 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:68)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:69 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:71)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:72 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:74)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:75 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:78)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:79 + ! FIXME: Verify the written output + ! pio_decomp_tests.F90.in:81 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests.F90.in:89 + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_write_1d_darray_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests.F90.in:91 + + +! Write 1d array, although diff procs have different +! number of elements to write locally they all use +! the same buffer size (compdof size is different for +! each rank but buf size is the same) +! Odd procs write out VEC_LOCAL_SZ_ODD elements & +! even procs write out VEC_LOCAL_SZ_EVEN elements, but +! all procs use buf[MAX_VEC_SZ] +! eg: +! Elements in buffer on each proc with MAX_VEC_SZ = 2, +! [0 1] [2 X] [3 4] [5 X] ... +! The 'X'es in the buffer are not written out + + +SUBROUTINE nc_wr_1d_const_buf_sz_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: MAX_VEC_SZ = 2 + integer, parameter :: VEC_LOCAL_SZ_ODD = MAX_VEC_SZ - 1 + integer, parameter :: VEC_LOCAL_SZ_EVEN = MAX_VEC_SZ + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: iodesc + integer, dimension(:), allocatable :: compdof, compdof_rel_disps + integer :: compdof_rel_start + integer :: cdof_sz = VEC_LOCAL_SZ_ODD + integer, dimension(MAX_VEC_SZ) :: wbuf, rbuf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + logical :: is_even = .false. + integer :: nodd_procs, nodd_procs_bfr, neven_procs, neven_procs_bfr + ! pio_decomp_tests.F90.in:127 + nodd_procs = pio_tf_world_sz_ / 2 + ! Number of odd procs before this rank + nodd_procs_bfr = pio_tf_world_rank_ / 2 + neven_procs = pio_tf_world_sz_ - nodd_procs + ! Number of even procs before this rank + neven_procs_bfr = pio_tf_world_rank_ - nodd_procs_bfr + ! pio_decomp_tests.F90.in:134 + ! Odd procs write out VEC_LOCAL_SZ_ODD elements & + ! even procs write out VEC_LOCAL_SZ_EVEN elements + if(mod(pio_tf_world_rank_, 2) == 0) then + is_even = .true. + cdof_sz = VEC_LOCAL_SZ_EVEN + end if + allocate(compdof(cdof_sz)) + allocate(compdof_rel_disps(cdof_sz)) + wbuf = 0 + rbuf = 0 + do i=1,cdof_sz + compdof_rel_disps(i) = i + wbuf(i) = i + end do + ! Find out where compdof starts for this rank + compdof_rel_start = nodd_procs_bfr * VEC_LOCAL_SZ_ODD +& + neven_procs_bfr * VEC_LOCAL_SZ_EVEN + dims(1) = nodd_procs * VEC_LOCAL_SZ_ODD + neven_procs * VEC_LOCAL_SZ_EVEN + compdof = compdof_rel_start + compdof_rel_disps + ! pio_decomp_tests.F90.in:154 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:156 + deallocate(compdof) + deallocate(compdof_rel_disps) + ! pio_decomp_tests.F90.in:159 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:166)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:167 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:169)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:170 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:172)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:173 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:175)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:176 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:179)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:180 + call PIO_syncfile(pio_file) + ! pio_decomp_tests.F90.in:182 + call PIO_read_darray(pio_file, pio_var, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:184)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:185 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:186)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:187 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_wr_1d_const_buf_sz_PIO_int_integer__ + + +SUBROUTINE nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: MAX_VEC_SZ = 2 + integer, parameter :: VEC_LOCAL_SZ_ODD = MAX_VEC_SZ - 1 + integer, parameter :: VEC_LOCAL_SZ_EVEN = MAX_VEC_SZ + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: iodesc + integer, dimension(:), allocatable :: compdof, compdof_rel_disps + integer :: compdof_rel_start + integer :: cdof_sz = VEC_LOCAL_SZ_ODD + real(kind=fc_real), dimension(MAX_VEC_SZ) :: wbuf, rbuf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + logical :: is_even = .false. + integer :: nodd_procs, nodd_procs_bfr, neven_procs, neven_procs_bfr + ! pio_decomp_tests.F90.in:127 + nodd_procs = pio_tf_world_sz_ / 2 + ! Number of odd procs before this rank + nodd_procs_bfr = pio_tf_world_rank_ / 2 + neven_procs = pio_tf_world_sz_ - nodd_procs + ! Number of even procs before this rank + neven_procs_bfr = pio_tf_world_rank_ - nodd_procs_bfr + ! pio_decomp_tests.F90.in:134 + ! Odd procs write out VEC_LOCAL_SZ_ODD elements & + ! even procs write out VEC_LOCAL_SZ_EVEN elements + if(mod(pio_tf_world_rank_, 2) == 0) then + is_even = .true. + cdof_sz = VEC_LOCAL_SZ_EVEN + end if + allocate(compdof(cdof_sz)) + allocate(compdof_rel_disps(cdof_sz)) + wbuf = 0 + rbuf = 0 + do i=1,cdof_sz + compdof_rel_disps(i) = i + wbuf(i) = i + end do + ! Find out where compdof starts for this rank + compdof_rel_start = nodd_procs_bfr * VEC_LOCAL_SZ_ODD +& + neven_procs_bfr * VEC_LOCAL_SZ_EVEN + dims(1) = nodd_procs * VEC_LOCAL_SZ_ODD + neven_procs * VEC_LOCAL_SZ_EVEN + compdof = compdof_rel_start + compdof_rel_disps + ! pio_decomp_tests.F90.in:154 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:156 + deallocate(compdof) + deallocate(compdof_rel_disps) + ! pio_decomp_tests.F90.in:159 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:166)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:167 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:169)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:170 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:172)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:173 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:175)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:176 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:179)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:180 + call PIO_syncfile(pio_file) + ! pio_decomp_tests.F90.in:182 + call PIO_read_darray(pio_file, pio_var, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:184)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:185 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:186)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:187 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: MAX_VEC_SZ = 2 + integer, parameter :: VEC_LOCAL_SZ_ODD = MAX_VEC_SZ - 1 + integer, parameter :: VEC_LOCAL_SZ_EVEN = MAX_VEC_SZ + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: iodesc + integer, dimension(:), allocatable :: compdof, compdof_rel_disps + integer :: compdof_rel_start + integer :: cdof_sz = VEC_LOCAL_SZ_ODD + real(kind=fc_double), dimension(MAX_VEC_SZ) :: wbuf, rbuf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + logical :: is_even = .false. + integer :: nodd_procs, nodd_procs_bfr, neven_procs, neven_procs_bfr + ! pio_decomp_tests.F90.in:127 + nodd_procs = pio_tf_world_sz_ / 2 + ! Number of odd procs before this rank + nodd_procs_bfr = pio_tf_world_rank_ / 2 + neven_procs = pio_tf_world_sz_ - nodd_procs + ! Number of even procs before this rank + neven_procs_bfr = pio_tf_world_rank_ - nodd_procs_bfr + ! pio_decomp_tests.F90.in:134 + ! Odd procs write out VEC_LOCAL_SZ_ODD elements & + ! even procs write out VEC_LOCAL_SZ_EVEN elements + if(mod(pio_tf_world_rank_, 2) == 0) then + is_even = .true. + cdof_sz = VEC_LOCAL_SZ_EVEN + end if + allocate(compdof(cdof_sz)) + allocate(compdof_rel_disps(cdof_sz)) + wbuf = 0 + rbuf = 0 + do i=1,cdof_sz + compdof_rel_disps(i) = i + wbuf(i) = i + end do + ! Find out where compdof starts for this rank + compdof_rel_start = nodd_procs_bfr * VEC_LOCAL_SZ_ODD +& + neven_procs_bfr * VEC_LOCAL_SZ_EVEN + dims(1) = nodd_procs * VEC_LOCAL_SZ_ODD + neven_procs * VEC_LOCAL_SZ_EVEN + compdof = compdof_rel_start + compdof_rel_disps + ! pio_decomp_tests.F90.in:154 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:156 + deallocate(compdof) + deallocate(compdof_rel_disps) + ! pio_decomp_tests.F90.in:159 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:166)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:167 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:169)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:170 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:172)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:173 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:175)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:176 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:179)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:180 + call PIO_syncfile(pio_file) + ! pio_decomp_tests.F90.in:182 + call PIO_read_darray(pio_file, pio_var, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:184)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:185 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:186)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:187 + call PIO_closefile(pio_file) + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests.F90.in:196 + + + + +SUBROUTINE nc_write_1d_reuse_decomp_PIO_int_integer__ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var1_file1, pio_var2_file1, pio_var1_file2 + type(file_desc_t) :: pio_file1, pio_file2 + character(len=PIO_TF_MAX_STR_LEN) :: filename1, filename2 + type(io_desc_t) :: iodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + integer, dimension(VEC_LOCAL_SZ) :: buf, rbuf + integer, dimension(1) :: dims + integer :: pio_dim_file1, pio_dim_file2 + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests.F90.in:215 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + buf = pio_tf_world_rank_; + ! pio_decomp_tests.F90.in:222 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:224 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename1 = "test_pio_decomp_simple_tests.testfile1" + filename2 = "test_pio_decomp_simple_tests.testfile2" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file1, iotypes(i),& + filename1, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:233)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:234 + ierr = PIO_createfile(pio_tf_iosystem_, pio_file2, iotypes(i),& + filename2, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:237)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:238 + ierr = PIO_def_dim(pio_file1, 'PIO_TF_test_dim', dims(1), pio_dim_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:240)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:241 + ierr = PIO_def_dim(pio_file2, 'PIO_TF_test_dim', dims(1), pio_dim_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:243)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:244 + ierr = PIO_def_var(pio_file1, 'PIO_TF_test_var1', PIO_int,& + (/pio_dim_file1/), pio_var1_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define first var : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:247)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:248 + ierr = PIO_def_var(pio_file1, 'PIO_TF_test_var2', PIO_int,& + (/pio_dim_file1/), pio_var2_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define second var : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:251)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:252 + ierr = PIO_def_var(pio_file2, 'PIO_TF_test_var1', PIO_int,& + (/pio_dim_file2/), pio_var1_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define first var : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:255)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:256 + ierr = PIO_enddef(pio_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:258)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:259 + ierr = PIO_enddef(pio_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:261)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:262 + ! Write the variables - file1 + call PIO_write_darray(pio_file1, pio_var1_file1, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write first darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:265)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:266 + call PIO_write_darray(pio_file1, pio_var2_file1, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write second darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:268)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:269 + ! Write the variables - file2 + call PIO_write_darray(pio_file2, pio_var1_file2, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write first darray : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:272)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:273 + call PIO_syncfile(pio_file1) + rbuf = 0 + call PIO_read_darray(pio_file1, pio_var1_file1, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read first darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:277)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:278 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:279)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:280 + rbuf = 0 + call PIO_read_darray(pio_file1, pio_var2_file1, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read second darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:283)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:284 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:285)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:286 + call PIO_syncfile(pio_file2) + rbuf = 0 + call PIO_read_darray(pio_file2, pio_var1_file2, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read first darray : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:290)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:291 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:292)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:293 + call PIO_closefile(pio_file1) + call PIO_closefile(pio_file2) + call PIO_deletefile(pio_tf_iosystem_, filename1); + call PIO_deletefile(pio_tf_iosystem_, filename2); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests.F90.in:303 + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_write_1d_reuse_decomp_PIO_int_integer__ + + +SUBROUTINE nc_write_1d_reuse_decomp_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var1_file1, pio_var2_file1, pio_var1_file2 + type(file_desc_t) :: pio_file1, pio_file2 + character(len=PIO_TF_MAX_STR_LEN) :: filename1, filename2 + type(io_desc_t) :: iodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + real(kind=fc_real), dimension(VEC_LOCAL_SZ) :: buf, rbuf + integer, dimension(1) :: dims + integer :: pio_dim_file1, pio_dim_file2 + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests.F90.in:215 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + buf = pio_tf_world_rank_; + ! pio_decomp_tests.F90.in:222 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:224 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename1 = "test_pio_decomp_simple_tests.testfile1" + filename2 = "test_pio_decomp_simple_tests.testfile2" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file1, iotypes(i),& + filename1, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:233)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:234 + ierr = PIO_createfile(pio_tf_iosystem_, pio_file2, iotypes(i),& + filename2, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:237)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:238 + ierr = PIO_def_dim(pio_file1, 'PIO_TF_test_dim', dims(1), pio_dim_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:240)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:241 + ierr = PIO_def_dim(pio_file2, 'PIO_TF_test_dim', dims(1), pio_dim_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:243)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:244 + ierr = PIO_def_var(pio_file1, 'PIO_TF_test_var1', PIO_real,& + (/pio_dim_file1/), pio_var1_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define first var : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:247)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:248 + ierr = PIO_def_var(pio_file1, 'PIO_TF_test_var2', PIO_real,& + (/pio_dim_file1/), pio_var2_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define second var : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:251)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:252 + ierr = PIO_def_var(pio_file2, 'PIO_TF_test_var1', PIO_real,& + (/pio_dim_file2/), pio_var1_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define first var : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:255)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:256 + ierr = PIO_enddef(pio_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:258)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:259 + ierr = PIO_enddef(pio_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:261)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:262 + ! Write the variables - file1 + call PIO_write_darray(pio_file1, pio_var1_file1, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write first darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:265)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:266 + call PIO_write_darray(pio_file1, pio_var2_file1, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write second darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:268)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:269 + ! Write the variables - file2 + call PIO_write_darray(pio_file2, pio_var1_file2, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write first darray : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:272)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:273 + call PIO_syncfile(pio_file1) + rbuf = 0 + call PIO_read_darray(pio_file1, pio_var1_file1, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read first darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:277)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:278 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:279)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:280 + rbuf = 0 + call PIO_read_darray(pio_file1, pio_var2_file1, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read second darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:283)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:284 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:285)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:286 + call PIO_syncfile(pio_file2) + rbuf = 0 + call PIO_read_darray(pio_file2, pio_var1_file2, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read first darray : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:290)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:291 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:292)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:293 + call PIO_closefile(pio_file1) + call PIO_closefile(pio_file2) + call PIO_deletefile(pio_tf_iosystem_, filename1); + call PIO_deletefile(pio_tf_iosystem_, filename2); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests.F90.in:303 + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_write_1d_reuse_decomp_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_write_1d_reuse_decomp_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + integer, parameter :: VEC_LOCAL_SZ = 7 + type(var_desc_t) :: pio_var1_file1, pio_var2_file1, pio_var1_file2 + type(file_desc_t) :: pio_file1, pio_file2 + character(len=PIO_TF_MAX_STR_LEN) :: filename1, filename2 + type(io_desc_t) :: iodesc + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps + real(kind=fc_double), dimension(VEC_LOCAL_SZ) :: buf, rbuf + integer, dimension(1) :: dims + integer :: pio_dim_file1, pio_dim_file2 + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests.F90.in:215 + do i=1,VEC_LOCAL_SZ + compdof_rel_disps(i) = i + end do + dims(1) = VEC_LOCAL_SZ * pio_tf_world_sz_ + compdof = VEC_LOCAL_SZ * pio_tf_world_rank_ + compdof_rel_disps + buf = pio_tf_world_rank_; + ! pio_decomp_tests.F90.in:222 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, iodesc) + ! pio_decomp_tests.F90.in:224 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename1 = "test_pio_decomp_simple_tests.testfile1" + filename2 = "test_pio_decomp_simple_tests.testfile2" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file1, iotypes(i),& + filename1, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:233)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:234 + ierr = PIO_createfile(pio_tf_iosystem_, pio_file2, iotypes(i),& + filename2, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:237)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:238 + ierr = PIO_def_dim(pio_file1, 'PIO_TF_test_dim', dims(1), pio_dim_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:240)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:241 + ierr = PIO_def_dim(pio_file2, 'PIO_TF_test_dim', dims(1), pio_dim_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:243)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:244 + ierr = PIO_def_var(pio_file1, 'PIO_TF_test_var1', PIO_double,& + (/pio_dim_file1/), pio_var1_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define first var : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:247)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:248 + ierr = PIO_def_var(pio_file1, 'PIO_TF_test_var2', PIO_double,& + (/pio_dim_file1/), pio_var2_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define second var : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:251)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:252 + ierr = PIO_def_var(pio_file2, 'PIO_TF_test_var1', PIO_double,& + (/pio_dim_file2/), pio_var1_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define first var : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:255)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:256 + ierr = PIO_enddef(pio_file1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:258)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:259 + ierr = PIO_enddef(pio_file2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:261)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:262 + ! Write the variables - file1 + call PIO_write_darray(pio_file1, pio_var1_file1, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write first darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:265)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:266 + call PIO_write_darray(pio_file1, pio_var2_file1, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write second darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:268)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:269 + ! Write the variables - file2 + call PIO_write_darray(pio_file2, pio_var1_file2, iodesc, buf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write first darray : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:272)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:273 + call PIO_syncfile(pio_file1) + rbuf = 0 + call PIO_read_darray(pio_file1, pio_var1_file1, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read first darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:277)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:278 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:279)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:280 + rbuf = 0 + call PIO_read_darray(pio_file1, pio_var2_file1, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read second darray : " // trim(filename1),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:283)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:284 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:285)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:286 + call PIO_syncfile(pio_file2) + rbuf = 0 + call PIO_read_darray(pio_file2, pio_var1_file2, iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read first darray : " // trim(filename2),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:290)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:291 + + IF (.NOT. PIO_TF_Check_val_(rbuf, buf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests.F90.in:292)" + END IF + RETURN + END IF + ! pio_decomp_tests.F90.in:293 + call PIO_closefile(pio_file1) + call PIO_closefile(pio_file2) + call PIO_deletefile(pio_tf_iosystem_, filename1); + call PIO_deletefile(pio_tf_iosystem_, filename2); + end do + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests.F90.in:303 + call PIO_freedecomp(pio_tf_iosystem_, iodesc) +END SUBROUTINE nc_write_1d_reuse_decomp_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests.F90.in:305 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_int_integer__" + END IF + CALL nc_write_1d_darray_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_1d_darray_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_1d_darray_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_darray_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_1d_darray_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_1d_darray_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_darray_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_1d_darray_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_1d_darray_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_int_integer__" + END IF + CALL nc_write_1d_darray_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_write_1d_darray_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_write_1d_darray_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_darray_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_write_1d_darray_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_write_1d_darray_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_darray_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_write_1d_darray_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_write_1d_darray_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_const_buf_sz_PIO_int_integer__" + END IF + CALL nc_wr_1d_const_buf_sz_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_wr_1d_const_buf_sz_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_wr_1d_const_buf_sz_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___" + END IF + CALL nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___" + END IF + CALL nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_int_integer__" + END IF + CALL nc_write_1d_darray_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "nc_write_1d_darray_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "nc_write_1d_darray_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_darray_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "nc_write_1d_darray_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "nc_write_1d_darray_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_darray_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_darray_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "nc_write_1d_darray_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "nc_write_1d_darray_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_const_buf_sz_PIO_int_integer__" + END IF + CALL nc_wr_1d_const_buf_sz_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "nc_wr_1d_const_buf_sz_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "nc_wr_1d_const_buf_sz_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___" + END IF + CALL nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "nc_wr_1d_const_buf_sz_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___" + END IF + CALL nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "nc_wr_1d_const_buf_sz_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_reuse_decomp_PIO_int_integer__" + END IF + CALL nc_write_1d_reuse_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "nc_write_1d_reuse_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "nc_write_1d_reuse_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_reuse_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_1d_reuse_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "nc_write_1d_reuse_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "nc_write_1d_reuse_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_1d_reuse_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_1d_reuse_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "nc_write_1d_reuse_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "nc_write_1d_reuse_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting init_decomp_1d_get_loc_sz" + END IF + CALL init_decomp_1d_get_loc_sz() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 19:",& + "init_decomp_1d_get_loc_sz","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 19:",& + "init_decomp_1d_get_loc_sz","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_decomp_tests_1d.F90.in2 b/tests/general/pio_decomp_tests_1d.F90.in2 new file mode 100644 index 00000000000..7521112d4e7 --- /dev/null +++ b/tests/general/pio_decomp_tests_1d.F90.in2 @@ -0,0 +1,2302 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_decomp_tests_1d.F90.in + +! Get a block cyclic decomposition +! If force_rearrange is FALSE, the decomposition is such that +! # All even procs have VEC_LOCAL_SZ elements +! # All odd procs have VEC_LOCAL_SZ + 1 elements +! e.g. For VEC_LOCAL_SZ = 2, +! e.g. 1) [1,2] [3,4,5] [6,7] +! e.g. 2) [1,2] [3,4,5] [6,7] [8,9,10] +! e.g. 3) [1,2] [3,4,5] [6,7] [8,9,10] [11,12] +! If force_rearrange is TRUE, the decomposition is such that, +! If possible, the even rank "exchanges" elements with the next +! higher ranked odd proc. +! This for example can be used to force rearrangement when reading +! or writing data. +! e.g. For VEC_LOCAL_SZ = 2, +! e.g. 1) [3,4,5] [1,2] [6,7] +! e.g. 2) [3,4,5] [1,2] [8,9,10] [6,7] +! e.g. 3) [3,4,5] [1,2] [8,9,10] [6,7] [11,12] +SUBROUTINE get_1d_bc_info(rank, sz, dims, start, count, force_rearrange) ! pio_decomp_tests_1d.F90.in:18 + integer, parameter :: VEC_LOCAL_SZ = 7 ! pio_decomp_tests_1d.F90.in:19 + integer, intent(in) :: rank ! pio_decomp_tests_1d.F90.in:20 + integer, intent(in) :: sz ! pio_decomp_tests_1d.F90.in:21 + integer, dimension(1), intent(out) :: dims ! pio_decomp_tests_1d.F90.in:22 + integer, dimension(1), intent(out) :: start ! pio_decomp_tests_1d.F90.in:23 + integer, dimension(1), intent(out) :: count ! pio_decomp_tests_1d.F90.in:24 + logical, intent(in) :: force_rearrange ! pio_decomp_tests_1d.F90.in:25 + + + logical :: is_even_rank ! pio_decomp_tests_1d.F90.in:27 + integer :: num_odd_procs, num_even_procs ! pio_decomp_tests_1d.F90.in:28 + integer :: iodd, ieven ! pio_decomp_tests_1d.F90.in:29 + + + is_even_rank = .false. ! pio_decomp_tests_1d.F90.in:31 + if (mod(rank, 2) == 0) then ! pio_decomp_tests_1d.F90.in:32 + is_even_rank = .true. ! pio_decomp_tests_1d.F90.in:33 + end if ! pio_decomp_tests_1d.F90.in:34 + num_odd_procs = sz / 2 ! pio_decomp_tests_1d.F90.in:35 + num_even_procs = sz - num_odd_procs ! pio_decomp_tests_1d.F90.in:36 + dims(1) = num_even_procs * VEC_LOCAL_SZ + num_odd_procs * (VEC_LOCAL_SZ + 1) ! pio_decomp_tests_1d.F90.in:37 + ! Number of odd and even procs before this rank + iodd = rank / 2 ! pio_decomp_tests_1d.F90.in:39 + ieven = (rank + 1) / 2 ! pio_decomp_tests_1d.F90.in:40 + if(force_rearrange) then ! pio_decomp_tests_1d.F90.in:41 + ! Make sure that we force rearrangement + if (is_even_rank) then ! pio_decomp_tests_1d.F90.in:43 + if(rank + 1 < sz) then ! pio_decomp_tests_1d.F90.in:44 + ! Force rearrangement + count(1) = VEC_LOCAL_SZ + 1 ! pio_decomp_tests_1d.F90.in:46 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + (VEC_LOCAL_SZ) + 1 ! pio_decomp_tests_1d.F90.in:47 + else ! pio_decomp_tests_1d.F90.in:48 + count(1) = VEC_LOCAL_SZ ! pio_decomp_tests_1d.F90.in:49 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + 1 ! pio_decomp_tests_1d.F90.in:50 + end if ! pio_decomp_tests_1d.F90.in:51 + else ! pio_decomp_tests_1d.F90.in:52 + ! For all odd procs there is an even lower ranked, rank-1, proc + ! So force rearrangement + count(1) = VEC_LOCAL_SZ ! pio_decomp_tests_1d.F90.in:55 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) - (VEC_LOCAL_SZ) + 1 ! pio_decomp_tests_1d.F90.in:56 + end if ! pio_decomp_tests_1d.F90.in:57 + else ! pio_decomp_tests_1d.F90.in:58 + if (is_even_rank) then ! pio_decomp_tests_1d.F90.in:59 + count(1) = VEC_LOCAL_SZ ! pio_decomp_tests_1d.F90.in:60 + else ! pio_decomp_tests_1d.F90.in:61 + count(1) = VEC_LOCAL_SZ + 1 ! pio_decomp_tests_1d.F90.in:62 + end if ! pio_decomp_tests_1d.F90.in:63 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + 1 ! pio_decomp_tests_1d.F90.in:64 + end if ! pio_decomp_tests_1d.F90.in:65 + + +END SUBROUTINE ! pio_decomp_tests_1d.F90.in:67 + + +! Get a 1d block decomposition with holes +! If has_hole is TRUE, the decomposition is such that +! # All even procs have VEC_LOCAL_SZ * 2 elements +! # (the even procs take all elems from the odd procs) +! # All odd procs have 0 elements +! e.g. For VEC_LOCAL_SZ = 2, +! e.g. 1) [1,2,3,4] [] [5,6] +! e.g. 2) [1,2,3,4] [] [5,6,7,8] [] +! If has_hole is FALSE, the data is evenly divided among all procs +! e.g. For VEC_LOCAL_SZ = 2, +! e.g. 1) [1,2] [3,4] [5,6] +! e.g. 2) [1,2] [3,4] [5,6] [7,8] +SUBROUTINE get_1d_bc_with_holes_info(rank, sz, dims, start, count, has_hole) ! pio_decomp_tests_1d.F90.in:81 + integer, parameter :: VEC_LOCAL_SZ = 7 ! pio_decomp_tests_1d.F90.in:82 + integer, intent(in) :: rank ! pio_decomp_tests_1d.F90.in:83 + integer, intent(in) :: sz ! pio_decomp_tests_1d.F90.in:84 + integer, dimension(1), intent(out) :: dims ! pio_decomp_tests_1d.F90.in:85 + integer, dimension(1), intent(out) :: start ! pio_decomp_tests_1d.F90.in:86 + integer, dimension(1), intent(out) :: count ! pio_decomp_tests_1d.F90.in:87 + logical, intent(in) :: has_hole ! pio_decomp_tests_1d.F90.in:88 + + + logical :: is_even_rank ! pio_decomp_tests_1d.F90.in:90 + integer :: num_odd_procs, num_even_procs ! pio_decomp_tests_1d.F90.in:91 + integer :: iodd, ieven ! pio_decomp_tests_1d.F90.in:92 + + + is_even_rank = .false. ! pio_decomp_tests_1d.F90.in:94 + if (mod(rank, 2) == 0) then ! pio_decomp_tests_1d.F90.in:95 + is_even_rank = .true. ! pio_decomp_tests_1d.F90.in:96 + end if ! pio_decomp_tests_1d.F90.in:97 + num_odd_procs = sz / 2 ! pio_decomp_tests_1d.F90.in:98 + num_even_procs = sz - num_odd_procs ! pio_decomp_tests_1d.F90.in:99 + dims(1) = VEC_LOCAL_SZ * sz ! pio_decomp_tests_1d.F90.in:100 + ! Number of odd and even procs before this rank + iodd = rank / 2 ! pio_decomp_tests_1d.F90.in:102 + ieven = (rank + 1) / 2 ! pio_decomp_tests_1d.F90.in:103 + if(has_hole) then ! pio_decomp_tests_1d.F90.in:104 + if (is_even_rank) then ! pio_decomp_tests_1d.F90.in:105 + if(rank + 1 < sz) then ! pio_decomp_tests_1d.F90.in:106 + count(1) = VEC_LOCAL_SZ * 2 ! pio_decomp_tests_1d.F90.in:107 + else ! pio_decomp_tests_1d.F90.in:108 + count(1) = VEC_LOCAL_SZ ! pio_decomp_tests_1d.F90.in:109 + end if ! pio_decomp_tests_1d.F90.in:110 + start(1) = ieven * VEC_LOCAL_SZ * 2 + 1 ! pio_decomp_tests_1d.F90.in:111 + else ! pio_decomp_tests_1d.F90.in:112 + count(1) = 0 ! pio_decomp_tests_1d.F90.in:113 + start(1) = 0 ! pio_decomp_tests_1d.F90.in:114 + end if ! pio_decomp_tests_1d.F90.in:115 + else ! pio_decomp_tests_1d.F90.in:116 + count(1) = VEC_LOCAL_SZ ! pio_decomp_tests_1d.F90.in:117 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ) + 1 ! pio_decomp_tests_1d.F90.in:118 + end if ! pio_decomp_tests_1d.F90.in:119 + + +END SUBROUTINE ! pio_decomp_tests_1d.F90.in:121 + + +! Test block cyclic interface +! Write with one decomp and read with another +! Test all combs +! - no rearrage read + no rearrange write +! - rearrage read + no rearrange write +! - no rearrage read + rearrange write +! - rearrage read + rearrange write + + +SUBROUTINE nc_wr_rd_1d_bc_PIO_int_integer__ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var1, pio_var2 + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(1) :: start, count + integer, dimension(:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + logical, dimension(2) :: enable_rd_rearr = (/.false., .true./) + integer :: rd_rearr_opt_idx + logical, dimension(2) :: enable_wr_rearr = (/.false., .true./) + integer :: wr_rearr_opt_idx + ! pio_decomp_tests_1d.F90.in:151 + do rd_rearr_opt_idx=1,size(enable_rd_rearr) + do wr_rearr_opt_idx=1,size(enable_wr_rearr) + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*, *) "Testing Rd rearr =", enable_rd_rearr(rd_rearr_opt_idx), ",Write rearr=", enable_wr_rearr(wr_rearr_opt_idx) + END IF + END IF + ! Set the decomposition for writing data - forcing rearrangement + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims,& + start, count, enable_wr_rearr(wr_rearr_opt_idx)) + allocate(wbuf(count(1))) + allocate(compdof(count(1))) + do i=1,count(1) + wbuf(i) = start(1) + i - 1 + compdof(i) = start(1) + i - 1 + end do + ! pio_decomp_tests_1d.F90.in:164 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:167 + ! Set the decomposition for reading data - different from the write decomp + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims,& + start, count, enable_rd_rearr(rd_rearr_opt_idx)) + allocate(rbuf(count(1))) + allocate(compdof(count(1))) + allocate(exp_val(count(1))) + do i=1,count(1) + compdof(i) = start(1) + i -1 + ! Expected value, after reading, is the same as the compdof + exp_val(i) = compdof(i) + end do + ! pio_decomp_tests_1d.F90.in:179 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:182 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:189)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:190 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:192)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:193 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var1', PIO_int, (/pio_dim/), pio_var1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:195)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:196 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var2', PIO_int, (/pio_dim/), pio_var2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:198)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:199 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:201)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:202 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var1, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:205)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:206 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:208 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var2, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:211)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:212 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:214 + rbuf = 0 + call PIO_read_darray(pio_file, pio_var1, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:217)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:218 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:219)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:220 + call PIO_closefile(pio_file) + wbuf = wbuf - 200 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:225 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:230 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) + end do + end do +END SUBROUTINE nc_wr_rd_1d_bc_PIO_int_integer__ + + +SUBROUTINE nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var1, pio_var2 + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(1) :: start, count + real(kind=fc_real), dimension(:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + logical, dimension(2) :: enable_rd_rearr = (/.false., .true./) + integer :: rd_rearr_opt_idx + logical, dimension(2) :: enable_wr_rearr = (/.false., .true./) + integer :: wr_rearr_opt_idx + ! pio_decomp_tests_1d.F90.in:151 + do rd_rearr_opt_idx=1,size(enable_rd_rearr) + do wr_rearr_opt_idx=1,size(enable_wr_rearr) + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*, *) "Testing Rd rearr =", enable_rd_rearr(rd_rearr_opt_idx), ",Write rearr=", enable_wr_rearr(wr_rearr_opt_idx) + END IF + END IF + ! Set the decomposition for writing data - forcing rearrangement + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims,& + start, count, enable_wr_rearr(wr_rearr_opt_idx)) + allocate(wbuf(count(1))) + allocate(compdof(count(1))) + do i=1,count(1) + wbuf(i) = start(1) + i - 1 + compdof(i) = start(1) + i - 1 + end do + ! pio_decomp_tests_1d.F90.in:164 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:167 + ! Set the decomposition for reading data - different from the write decomp + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims,& + start, count, enable_rd_rearr(rd_rearr_opt_idx)) + allocate(rbuf(count(1))) + allocate(compdof(count(1))) + allocate(exp_val(count(1))) + do i=1,count(1) + compdof(i) = start(1) + i -1 + ! Expected value, after reading, is the same as the compdof + exp_val(i) = compdof(i) + end do + ! pio_decomp_tests_1d.F90.in:179 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:182 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:189)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:190 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:192)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:193 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var1', PIO_real, (/pio_dim/), pio_var1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:195)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:196 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var2', PIO_real, (/pio_dim/), pio_var2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:198)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:199 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:201)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:202 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var1, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:205)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:206 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:208 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var2, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:211)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:212 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:214 + rbuf = 0 + call PIO_read_darray(pio_file, pio_var1, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:217)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:218 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:219)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:220 + call PIO_closefile(pio_file) + wbuf = wbuf - 200 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:225 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:230 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) + end do + end do +END SUBROUTINE nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var1, pio_var2 + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(1) :: start, count + real(kind=fc_double), dimension(:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + logical, dimension(2) :: enable_rd_rearr = (/.false., .true./) + integer :: rd_rearr_opt_idx + logical, dimension(2) :: enable_wr_rearr = (/.false., .true./) + integer :: wr_rearr_opt_idx + ! pio_decomp_tests_1d.F90.in:151 + do rd_rearr_opt_idx=1,size(enable_rd_rearr) + do wr_rearr_opt_idx=1,size(enable_wr_rearr) + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*, *) "Testing Rd rearr =", enable_rd_rearr(rd_rearr_opt_idx), ",Write rearr=", enable_wr_rearr(wr_rearr_opt_idx) + END IF + END IF + ! Set the decomposition for writing data - forcing rearrangement + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims,& + start, count, enable_wr_rearr(wr_rearr_opt_idx)) + allocate(wbuf(count(1))) + allocate(compdof(count(1))) + do i=1,count(1) + wbuf(i) = start(1) + i - 1 + compdof(i) = start(1) + i - 1 + end do + ! pio_decomp_tests_1d.F90.in:164 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:167 + ! Set the decomposition for reading data - different from the write decomp + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims,& + start, count, enable_rd_rearr(rd_rearr_opt_idx)) + allocate(rbuf(count(1))) + allocate(compdof(count(1))) + allocate(exp_val(count(1))) + do i=1,count(1) + compdof(i) = start(1) + i -1 + ! Expected value, after reading, is the same as the compdof + exp_val(i) = compdof(i) + end do + ! pio_decomp_tests_1d.F90.in:179 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:182 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:189)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:190 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:192)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:193 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var1', PIO_double, (/pio_dim/), pio_var1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:195)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:196 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var2', PIO_double, (/pio_dim/), pio_var2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:198)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:199 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:201)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:202 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var1, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:205)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:206 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:208 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var2, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:211)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:212 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:214 + rbuf = 0 + call PIO_read_darray(pio_file, pio_var1, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:217)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:218 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:219)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:220 + call PIO_closefile(pio_file) + wbuf = wbuf - 200 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:225 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:230 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) + end do + end do +END SUBROUTINE nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests_1d.F90.in:238 + + + + +SUBROUTINE nc_wr_1d_bc_with_holes_PIO_int_integer__ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(1) :: start, count + integer, dimension(:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_1d.F90.in:257 + ! Set the decomposition for writing data - has holes + call get_1d_bc_with_holes_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + allocate(wbuf(count(1))) + allocate(rbuf(count(1))) + allocate(compdof(count(1))) + allocate(exp_val(count(1))) + do i=1,count(1) + wbuf(i) = start(1) + i - 1 + compdof(i) = wbuf(i) + exp_val(i) = wbuf(i) + end do + ! pio_decomp_tests_1d.F90.in:269 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:272 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:279)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:280 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:282)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:283 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:285)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:286 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:288)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:289 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:292)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:293 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:295 + call PIO_read_darray(pio_file, pio_var, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:297)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:298 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:299)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:300 + call PIO_closefile(pio_file) + ! pio_decomp_tests_1d.F90.in:302 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:305 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:310 + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_wr_1d_bc_with_holes_PIO_int_integer__ + + +SUBROUTINE nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(1) :: start, count + real(kind=fc_real), dimension(:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_1d.F90.in:257 + ! Set the decomposition for writing data - has holes + call get_1d_bc_with_holes_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + allocate(wbuf(count(1))) + allocate(rbuf(count(1))) + allocate(compdof(count(1))) + allocate(exp_val(count(1))) + do i=1,count(1) + wbuf(i) = start(1) + i - 1 + compdof(i) = wbuf(i) + exp_val(i) = wbuf(i) + end do + ! pio_decomp_tests_1d.F90.in:269 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:272 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:279)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:280 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:282)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:283 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:285)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:286 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:288)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:289 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:292)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:293 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:295 + call PIO_read_darray(pio_file, pio_var, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:297)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:298 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:299)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:300 + call PIO_closefile(pio_file) + ! pio_decomp_tests_1d.F90.in:302 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:305 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:310 + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(1) :: start, count + real(kind=fc_double), dimension(:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, ierr, lsz + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_1d.F90.in:257 + ! Set the decomposition for writing data - has holes + call get_1d_bc_with_holes_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + allocate(wbuf(count(1))) + allocate(rbuf(count(1))) + allocate(compdof(count(1))) + allocate(exp_val(count(1))) + do i=1,count(1) + wbuf(i) = start(1) + i - 1 + compdof(i) = wbuf(i) + exp_val(i) = wbuf(i) + end do + ! pio_decomp_tests_1d.F90.in:269 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:272 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:279)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:280 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:282)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:283 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, (/pio_dim/), pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:285)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:286 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:288)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:289 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:292)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:293 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:295 + call PIO_read_darray(pio_file, pio_var, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:297)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:298 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:299)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:300 + call PIO_closefile(pio_file) + ! pio_decomp_tests_1d.F90.in:302 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:305 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:310 + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests_1d.F90.in:315 + + + + +SUBROUTINE nc_wr_1d_bc_random_PIO_int_integer__ +USE pio_tutil + + use mpi, only : MPI_INT + implicit none + type(var_desc_t) :: pio_var1, pio_var2 + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc + integer, dimension(:), allocatable :: compdof, gcompdof + integer, dimension(1) :: count + integer, dimension(:), allocatable :: rbuf, wbuf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, j, ierr, lsz + integer :: tmp + real :: u + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_1d.F90.in:337 + ! Set the decomposition for writing data - random order same local size + count(1) = 4 + dims(1) = count(1)*pio_tf_world_sz_ + if(pio_tf_world_rank_ == 0) then + allocate(gcompdof(dims(1))) + gcompdof = 0 + do i=1,dims(1) + gcompdof(i) = i + enddo + do i=dims(1),1,-1 + call random_number(u) + j = CEILING(real(i)*u) + tmp = gcompdof(j) + gcompdof(j) = gcompdof(i) + gcompdof(i) = tmp + enddo + endif + allocate(compdof(count(1))) + call mpi_scatter(gcompdof, count(1), MPI_INT, compdof, 4, MPI_INT, 0, pio_tf_comm_, ierr) + if(allocated(gcompdof)) deallocate(gcompdof) + allocate(rbuf(count(1))) + allocate(wbuf(count(1))) + do i=1,count(1) + wbuf(i) = compdof(i) + end do + ! pio_decomp_tests_1d.F90.in:363 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:366 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:373)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:374 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:376)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:377 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var1', PIO_int, (/pio_dim/), pio_var1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:379)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:380 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var2', PIO_int, (/pio_dim/), pio_var2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:382)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:383 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:385)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:386 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var1, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:389)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:390 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:392 + call PIO_write_darray(pio_file, pio_var2, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:394)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:395 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:397 + ! pio_decomp_tests_1d.F90.in:398 + call PIO_read_darray(pio_file, pio_var1, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:400)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:401 + wbuf = wbuf - 200 + ! pio_decomp_tests_1d.F90.in:403 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:404)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:405 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:407 + call PIO_read_darray(pio_file, pio_var2, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:409)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:410 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:411)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:412 + call PIO_closefile(pio_file) + ! pio_decomp_tests_1d.F90.in:414 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:416 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:419 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:424 + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_wr_1d_bc_random_PIO_int_integer__ + + +SUBROUTINE nc_wr_1d_bc_random_PIO_real_real_kind_fc_real___ +USE pio_tutil + + use mpi, only : MPI_INT + implicit none + type(var_desc_t) :: pio_var1, pio_var2 + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc + integer, dimension(:), allocatable :: compdof, gcompdof + integer, dimension(1) :: count + real(kind=fc_real), dimension(:), allocatable :: rbuf, wbuf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, j, ierr, lsz + integer :: tmp + real :: u + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_1d.F90.in:337 + ! Set the decomposition for writing data - random order same local size + count(1) = 4 + dims(1) = count(1)*pio_tf_world_sz_ + if(pio_tf_world_rank_ == 0) then + allocate(gcompdof(dims(1))) + gcompdof = 0 + do i=1,dims(1) + gcompdof(i) = i + enddo + do i=dims(1),1,-1 + call random_number(u) + j = CEILING(real(i)*u) + tmp = gcompdof(j) + gcompdof(j) = gcompdof(i) + gcompdof(i) = tmp + enddo + endif + allocate(compdof(count(1))) + call mpi_scatter(gcompdof, count(1), MPI_INT, compdof, 4, MPI_INT, 0, pio_tf_comm_, ierr) + if(allocated(gcompdof)) deallocate(gcompdof) + allocate(rbuf(count(1))) + allocate(wbuf(count(1))) + do i=1,count(1) + wbuf(i) = compdof(i) + end do + ! pio_decomp_tests_1d.F90.in:363 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:366 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:373)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:374 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:376)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:377 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var1', PIO_real, (/pio_dim/), pio_var1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:379)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:380 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var2', PIO_real, (/pio_dim/), pio_var2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:382)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:383 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:385)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:386 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var1, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:389)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:390 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:392 + call PIO_write_darray(pio_file, pio_var2, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:394)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:395 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:397 + ! pio_decomp_tests_1d.F90.in:398 + call PIO_read_darray(pio_file, pio_var1, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:400)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:401 + wbuf = wbuf - 200 + ! pio_decomp_tests_1d.F90.in:403 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:404)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:405 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:407 + call PIO_read_darray(pio_file, pio_var2, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:409)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:410 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:411)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:412 + call PIO_closefile(pio_file) + ! pio_decomp_tests_1d.F90.in:414 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:416 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:419 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:424 + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_wr_1d_bc_random_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_wr_1d_bc_random_PIO_double_real_kind_fc_double___ +USE pio_tutil + + use mpi, only : MPI_INT + implicit none + type(var_desc_t) :: pio_var1, pio_var2 + type(file_desc_t) :: pio_file + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc + integer, dimension(:), allocatable :: compdof, gcompdof + integer, dimension(1) :: count + real(kind=fc_double), dimension(:), allocatable :: rbuf, wbuf + integer, dimension(1) :: dims + integer :: pio_dim + integer :: i, j, ierr, lsz + integer :: tmp + real :: u + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_1d.F90.in:337 + ! Set the decomposition for writing data - random order same local size + count(1) = 4 + dims(1) = count(1)*pio_tf_world_sz_ + if(pio_tf_world_rank_ == 0) then + allocate(gcompdof(dims(1))) + gcompdof = 0 + do i=1,dims(1) + gcompdof(i) = i + enddo + do i=dims(1),1,-1 + call random_number(u) + j = CEILING(real(i)*u) + tmp = gcompdof(j) + gcompdof(j) = gcompdof(i) + gcompdof(i) = tmp + enddo + endif + allocate(compdof(count(1))) + call mpi_scatter(gcompdof, count(1), MPI_INT, compdof, 4, MPI_INT, 0, pio_tf_comm_, ierr) + if(allocated(gcompdof)) deallocate(gcompdof) + allocate(rbuf(count(1))) + allocate(wbuf(count(1))) + do i=1,count(1) + wbuf(i) = compdof(i) + end do + ! pio_decomp_tests_1d.F90.in:363 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_1d.F90.in:366 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:373)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:374 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim', dims(1), pio_dim) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:376)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:377 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var1', PIO_double, (/pio_dim/), pio_var1) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:379)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:380 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var2', PIO_double, (/pio_dim/), pio_var2) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:382)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:383 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:385)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:386 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var1, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:389)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:390 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:392 + call PIO_write_darray(pio_file, pio_var2, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:394)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:395 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_1d.F90.in:397 + ! pio_decomp_tests_1d.F90.in:398 + call PIO_read_darray(pio_file, pio_var1, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:400)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:401 + wbuf = wbuf - 200 + ! pio_decomp_tests_1d.F90.in:403 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:404)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:405 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:407 + call PIO_read_darray(pio_file, pio_var2, wr_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:409)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:410 + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_1d.F90.in:411)" + END IF + RETURN + END IF + ! pio_decomp_tests_1d.F90.in:412 + call PIO_closefile(pio_file) + ! pio_decomp_tests_1d.F90.in:414 + wbuf = wbuf + 200 + ! pio_decomp_tests_1d.F90.in:416 + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_1d.F90.in:419 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_1d.F90.in:424 + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_wr_1d_bc_random_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests_1d.F90.in:428 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_int_integer__" + END IF + CALL nc_wr_rd_1d_bc_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_wr_rd_1d_bc_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_wr_rd_1d_bc_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___" + END IF + CALL nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___" + END IF + CALL nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_int_integer__" + END IF + CALL nc_wr_rd_1d_bc_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_wr_rd_1d_bc_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_wr_rd_1d_bc_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___" + END IF + CALL nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___" + END IF + CALL nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_with_holes_PIO_int_integer__" + END IF + CALL nc_wr_1d_bc_with_holes_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_wr_1d_bc_with_holes_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_wr_1d_bc_with_holes_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___" + END IF + CALL nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___" + END IF + CALL nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_int_integer__" + END IF + CALL nc_wr_rd_1d_bc_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "nc_wr_rd_1d_bc_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 10:",& + "nc_wr_rd_1d_bc_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___" + END IF + CALL nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 11:",& + "nc_wr_rd_1d_bc_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___" + END IF + CALL nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 12:",& + "nc_wr_rd_1d_bc_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_with_holes_PIO_int_integer__" + END IF + CALL nc_wr_1d_bc_with_holes_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "nc_wr_1d_bc_with_holes_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 13:",& + "nc_wr_1d_bc_with_holes_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___" + END IF + CALL nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 14:",& + "nc_wr_1d_bc_with_holes_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___" + END IF + CALL nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 15:",& + "nc_wr_1d_bc_with_holes_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_random_PIO_int_integer__" + END IF + CALL nc_wr_1d_bc_random_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "nc_wr_1d_bc_random_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 16:",& + "nc_wr_1d_bc_random_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_random_PIO_real_real_kind_fc_real___" + END IF + CALL nc_wr_1d_bc_random_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "nc_wr_1d_bc_random_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 17:",& + "nc_wr_1d_bc_random_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_wr_1d_bc_random_PIO_double_real_kind_fc_double___" + END IF + CALL nc_wr_1d_bc_random_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "nc_wr_1d_bc_random_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 18:",& + "nc_wr_1d_bc_random_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_decomp_tests_2d.F90.in2 b/tests/general/pio_decomp_tests_2d.F90.in2 new file mode 100644 index 00000000000..24b998dc790 --- /dev/null +++ b/tests/general/pio_decomp_tests_2d.F90.in2 @@ -0,0 +1,1537 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_decomp_tests_2d.F90.in + +! Get a 2D column decomposition +! If force_rearrange is FALSE, the decomposition is such that +! # All even procs have VEC_COL_SZ rows of VEC_ROW_SZ elements +! # All odd procs have VEC_COL_SZ rows of VEC_ROW_SZ + 1 elements +! e.g. For VEC_ROW_SZ = 2, VEC_COL_SZ = 2 and ranks 0, 1, 2, +! e.g. 1) |(1,1) (1,2)| |(1,3) (1,4) (1,5)| |(1,6) (1,7)| +! |(2,1) (2,2)|, |(2,3) (2,4) (2,5)|, |(2,6) (2,7)| +! If force_rearrange is TRUE, the decomposition is such that, +! If possible, the even rank "exchanges" elements with the next +! higher ranked odd proc. +! This for example can be used to force rearrangement when reading +! or writing data. +! e.g. For VEC_ROW_SZ = 2, VEC_COL_SZ = 2 and ranks 0, 1, 2 +! e.g. 1) |(1,3) (1,4) (1,5)| |(1,1) (1,2)| |(1,6) (1,7)| +! |(2,3) (2,4) (2,5)|, |(2,1) (2,2)|, |(2,6) (2,7)| +SUBROUTINE get_2d_col_decomp_info(rank, sz, dims, start, count, force_rearrange) ! pio_decomp_tests_2d.F90.in:16 + integer, parameter :: VEC_ROW_SZ = 7 ! pio_decomp_tests_2d.F90.in:17 + integer, parameter :: VEC_COL_SZ = 7 ! pio_decomp_tests_2d.F90.in:18 + integer, parameter :: NDIMS = 2 ! pio_decomp_tests_2d.F90.in:19 + integer, intent(in) :: rank ! pio_decomp_tests_2d.F90.in:20 + integer, intent(in) :: sz ! pio_decomp_tests_2d.F90.in:21 + integer, dimension(NDIMS), intent(out) :: dims ! pio_decomp_tests_2d.F90.in:22 + integer, dimension(NDIMS), intent(out) :: start ! pio_decomp_tests_2d.F90.in:23 + integer, dimension(NDIMS), intent(out) :: count ! pio_decomp_tests_2d.F90.in:24 + logical, intent(in) :: force_rearrange ! pio_decomp_tests_2d.F90.in:25 + + + logical :: is_even_rank ! pio_decomp_tests_2d.F90.in:27 + integer :: num_odd_procs, num_even_procs ! pio_decomp_tests_2d.F90.in:28 + integer :: iodd, ieven ! pio_decomp_tests_2d.F90.in:29 + + + is_even_rank = .false. ! pio_decomp_tests_2d.F90.in:31 + if (mod(rank, 2) == 0) then ! pio_decomp_tests_2d.F90.in:32 + is_even_rank = .true. ! pio_decomp_tests_2d.F90.in:33 + end if ! pio_decomp_tests_2d.F90.in:34 + num_odd_procs = sz / 2 ! pio_decomp_tests_2d.F90.in:35 + num_even_procs = sz - num_odd_procs ! pio_decomp_tests_2d.F90.in:36 + dims(1) = VEC_COL_SZ ! pio_decomp_tests_2d.F90.in:37 + dims(2) = num_even_procs * VEC_ROW_SZ + num_odd_procs * (VEC_ROW_SZ + 1) ! pio_decomp_tests_2d.F90.in:38 + ! Number of odd and even procs before this rank + iodd = rank / 2 ! pio_decomp_tests_2d.F90.in:40 + ieven = (rank + 1) / 2 ! pio_decomp_tests_2d.F90.in:41 + + + ! Rows + start(1) = 1 ! pio_decomp_tests_2d.F90.in:44 + count(1) = VEC_COL_SZ ! pio_decomp_tests_2d.F90.in:45 + + + ! Columns + if(force_rearrange) then ! pio_decomp_tests_2d.F90.in:48 + ! Make sure that we force rearrangement + if (is_even_rank) then ! pio_decomp_tests_2d.F90.in:50 + if(rank + 1 < sz) then ! pio_decomp_tests_2d.F90.in:51 + ! Force rearrangement + count(2) = VEC_ROW_SZ + 1 ! pio_decomp_tests_2d.F90.in:53 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + (VEC_ROW_SZ) + 1 ! pio_decomp_tests_2d.F90.in:54 + else ! pio_decomp_tests_2d.F90.in:55 + count(2) = VEC_ROW_SZ ! pio_decomp_tests_2d.F90.in:56 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + 1 ! pio_decomp_tests_2d.F90.in:57 + end if ! pio_decomp_tests_2d.F90.in:58 + else ! pio_decomp_tests_2d.F90.in:59 + ! For all odd procs there is an even lower ranked, rank-1, proc + ! So force rearrangement + count(2) = VEC_ROW_SZ ! pio_decomp_tests_2d.F90.in:62 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) - (VEC_ROW_SZ) + 1 ! pio_decomp_tests_2d.F90.in:63 + end if ! pio_decomp_tests_2d.F90.in:64 + else ! pio_decomp_tests_2d.F90.in:65 + if (is_even_rank) then ! pio_decomp_tests_2d.F90.in:66 + count(2) = VEC_ROW_SZ ! pio_decomp_tests_2d.F90.in:67 + else ! pio_decomp_tests_2d.F90.in:68 + count(2) = VEC_ROW_SZ + 1 ! pio_decomp_tests_2d.F90.in:69 + end if ! pio_decomp_tests_2d.F90.in:70 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + 1 ! pio_decomp_tests_2d.F90.in:71 + end if ! pio_decomp_tests_2d.F90.in:72 + + +END SUBROUTINE ! pio_decomp_tests_2d.F90.in:74 + + +! Get a 2D row decomposition +! If force_rearrange is FALSE, the decomposition is such that +! # All even procs have VEC_COL_SZ rows of VEC_ROW_SZ elements +! # All odd procs have VEC_COL_SZ+1 rows of VEC_ROW_SZ elements +! e.g. For VEC_ROW_SZ = 6, VEC_COL_SZ = 1 and ranks 0, 1, 2, +! e.g. 1) |(1,1) (1,2) (1,3) (1,4) (1,5) (1,6)|, +! |(2,1) (2,2) (2,3) (2,4) (2,5) (2,6)| +! |(3,1) (3,2) (3,3) (3,4) (3,5) (3,6)|, +! |(4,1) (4,2) (4,3) (4,4) (4,5) (4,6)| +! If force_rearrange is TRUE, the decomposition is such that, +! If possible, the even rank "exchanges" elements (rows) with the next +! higher ranked odd proc. +! This for example can be used to force rearrangement when reading +! or writing data. +! e.g. For VEC_ROW_SZ = 6, VEC_COL_SZ = 1 and ranks 0, 1, 2 +! e.g. 1) |(2,1) (2,2) (2,3) (2,4) (2,5) (2,6)| +! |(3,1) (3,2) (3,3) (3,4) (3,5) (3,6)|, +! |(1,1) (1,2) (1,3) (1,4) (1,5) (1,6)|, +! |(4,1) (4,2) (4,3) (4,4) (4,5) (4,6)| +SUBROUTINE get_2d_row_decomp_info(rank, sz, dims, start, count, force_rearrange) ! pio_decomp_tests_2d.F90.in:95 + integer, parameter :: VEC_COL_SZ = 7 ! pio_decomp_tests_2d.F90.in:96 + integer, parameter :: VEC_ROW_SZ = 7 ! pio_decomp_tests_2d.F90.in:97 + integer, parameter :: NDIMS = 2 ! pio_decomp_tests_2d.F90.in:98 + integer, intent(in) :: rank ! pio_decomp_tests_2d.F90.in:99 + integer, intent(in) :: sz ! pio_decomp_tests_2d.F90.in:100 + integer, dimension(NDIMS), intent(out) :: dims ! pio_decomp_tests_2d.F90.in:101 + integer, dimension(NDIMS), intent(out) :: start ! pio_decomp_tests_2d.F90.in:102 + integer, dimension(NDIMS), intent(out) :: count ! pio_decomp_tests_2d.F90.in:103 + logical, intent(in) :: force_rearrange ! pio_decomp_tests_2d.F90.in:104 + + + logical :: is_even_rank ! pio_decomp_tests_2d.F90.in:106 + integer :: num_odd_procs, num_even_procs ! pio_decomp_tests_2d.F90.in:107 + integer :: iodd, ieven ! pio_decomp_tests_2d.F90.in:108 + + + is_even_rank = .false. ! pio_decomp_tests_2d.F90.in:110 + if (mod(rank, 2) == 0) then ! pio_decomp_tests_2d.F90.in:111 + is_even_rank = .true. ! pio_decomp_tests_2d.F90.in:112 + end if ! pio_decomp_tests_2d.F90.in:113 + num_odd_procs = sz / 2 ! pio_decomp_tests_2d.F90.in:114 + num_even_procs = sz - num_odd_procs ! pio_decomp_tests_2d.F90.in:115 + dims(1) = num_even_procs * VEC_COL_SZ + num_odd_procs * (VEC_COL_SZ + 1) ! pio_decomp_tests_2d.F90.in:116 + dims(2) = VEC_ROW_SZ ! pio_decomp_tests_2d.F90.in:117 + ! Number of odd and even procs before this rank + iodd = rank / 2 ! pio_decomp_tests_2d.F90.in:119 + ieven = (rank + 1) / 2 ! pio_decomp_tests_2d.F90.in:120 + + + ! Rows + if(force_rearrange) then ! pio_decomp_tests_2d.F90.in:123 + ! Make sure that we force rearrangement + if (is_even_rank) then ! pio_decomp_tests_2d.F90.in:125 + if(rank + 1 < sz) then ! pio_decomp_tests_2d.F90.in:126 + ! Force rearrangement + count(1) = VEC_COL_SZ + 1 ! pio_decomp_tests_2d.F90.in:128 + start(1) = ieven * VEC_COL_SZ + iodd * (VEC_COL_SZ + 1) + (VEC_COL_SZ) + 1 ! pio_decomp_tests_2d.F90.in:129 + else ! pio_decomp_tests_2d.F90.in:130 + count(1) = VEC_COL_SZ ! pio_decomp_tests_2d.F90.in:131 + start(1) = ieven * VEC_COL_SZ + iodd * (VEC_COL_SZ + 1) + 1 ! pio_decomp_tests_2d.F90.in:132 + end if ! pio_decomp_tests_2d.F90.in:133 + else ! pio_decomp_tests_2d.F90.in:134 + ! For all odd procs there is an even lower ranked, rank-1, proc + ! So force rearrangement + count(1) = VEC_COL_SZ ! pio_decomp_tests_2d.F90.in:137 + start(1) = ieven * VEC_COL_SZ + iodd * (VEC_COL_SZ + 1) - (VEC_COL_SZ) + 1 ! pio_decomp_tests_2d.F90.in:138 + end if ! pio_decomp_tests_2d.F90.in:139 + else ! pio_decomp_tests_2d.F90.in:140 + if (is_even_rank) then ! pio_decomp_tests_2d.F90.in:141 + count(1) = VEC_COL_SZ ! pio_decomp_tests_2d.F90.in:142 + else ! pio_decomp_tests_2d.F90.in:143 + count(1) = VEC_COL_SZ + 1 ! pio_decomp_tests_2d.F90.in:144 + end if ! pio_decomp_tests_2d.F90.in:145 + start(1) = ieven * VEC_COL_SZ + iodd * (VEC_COL_SZ + 1) + 1 ! pio_decomp_tests_2d.F90.in:146 + end if ! pio_decomp_tests_2d.F90.in:147 + + + ! Columns + start(2) = 1 ! pio_decomp_tests_2d.F90.in:150 + count(2) = VEC_ROW_SZ ! pio_decomp_tests_2d.F90.in:151 + + +END SUBROUTINE ! pio_decomp_tests_2d.F90.in:153 + + +! Write with one decomp (to force rearrangement) and read with another (no +! rearrangement) + + +SUBROUTINE nc_write_read_2d_col_decomp_PIO_int_integer__ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 2 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + integer, dimension(:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, tmp_idx, ierr, lsz, nrows, ncols + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_2d.F90.in:175 + ! Set the decomposition for writing data - forcing rearrangement + call get_2d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + + allocate(wbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + do j=1,ncols + do i=1,nrows + wbuf(i,j) = (start(2) - 1 + j - 1) * nrows + i + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j) + end do + end do + ! pio_decomp_tests_2d.F90.in:190 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:193 + ! Set the decomposition for reading data - different from the write decomp + call get_2d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + + allocate(rbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + allocate(exp_val(nrows, ncols)) + do j=1,ncols + do i=1,nrows + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = (start(2) - 1 + j - 1) * nrows + i + ! Expected value, after reading, is the same as the compdof + exp_val(i,j) = compdof(tmp_idx) + end do + end do + ! pio_decomp_tests_2d.F90.in:210 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:213 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:220)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:221 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:223)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:224 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:226)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:227 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:229)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:230 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:232)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:233 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:236)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:237 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_2d.F90.in:239 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:241)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:242 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:243)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:244 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_2d.F90.in:249 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_2d.F90.in:254 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_2d_col_decomp_PIO_int_integer__ + + +SUBROUTINE nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 2 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_real), dimension(:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, tmp_idx, ierr, lsz, nrows, ncols + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_2d.F90.in:175 + ! Set the decomposition for writing data - forcing rearrangement + call get_2d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + + allocate(wbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + do j=1,ncols + do i=1,nrows + wbuf(i,j) = (start(2) - 1 + j - 1) * nrows + i + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j) + end do + end do + ! pio_decomp_tests_2d.F90.in:190 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:193 + ! Set the decomposition for reading data - different from the write decomp + call get_2d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + + allocate(rbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + allocate(exp_val(nrows, ncols)) + do j=1,ncols + do i=1,nrows + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = (start(2) - 1 + j - 1) * nrows + i + ! Expected value, after reading, is the same as the compdof + exp_val(i,j) = compdof(tmp_idx) + end do + end do + ! pio_decomp_tests_2d.F90.in:210 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:213 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:220)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:221 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:223)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:224 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:226)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:227 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:229)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:230 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:232)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:233 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:236)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:237 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_2d.F90.in:239 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:241)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:242 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:243)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:244 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_2d.F90.in:249 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_2d.F90.in:254 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 2 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_double), dimension(:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, tmp_idx, ierr, lsz, nrows, ncols + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_2d.F90.in:175 + ! Set the decomposition for writing data - forcing rearrangement + call get_2d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + + allocate(wbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + do j=1,ncols + do i=1,nrows + wbuf(i,j) = (start(2) - 1 + j - 1) * nrows + i + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j) + end do + end do + ! pio_decomp_tests_2d.F90.in:190 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:193 + ! Set the decomposition for reading data - different from the write decomp + call get_2d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + + allocate(rbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + allocate(exp_val(nrows, ncols)) + do j=1,ncols + do i=1,nrows + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = (start(2) - 1 + j - 1) * nrows + i + ! Expected value, after reading, is the same as the compdof + exp_val(i,j) = compdof(tmp_idx) + end do + end do + ! pio_decomp_tests_2d.F90.in:210 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:213 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:220)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:221 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:223)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:224 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:226)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:227 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:229)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:230 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:232)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:233 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:236)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:237 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_2d.F90.in:239 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:241)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:242 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:243)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:244 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_2d.F90.in:249 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_2d.F90.in:254 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests_2d.F90.in:260 + + +! Write with one decomp (to force rearrangement) and read with another (no +! rearrangement) + + +SUBROUTINE nc_write_read_2d_row_decomp_PIO_int_integer__ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 2 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + integer, dimension(:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, tmp_idx, ierr, lsz, nrows, ncols + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_2d.F90.in:282 + ! Set the decomposition for writing data - forcing rearrangement + call get_2d_row_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + ! pio_decomp_tests_2d.F90.in:287 + allocate(wbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + do j=1,ncols + do i=1,nrows + wbuf(i,j) = (start(2) - 1 + j - 1) * dims(1) + start(1) + i - 1 + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j) + end do + end do + ! pio_decomp_tests_2d.F90.in:297 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:300 + ! Set the decomposition for reading data - different from the write decomp + call get_2d_row_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + + allocate(rbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + allocate(exp_val(nrows, ncols)) + do j=1,ncols + do i=1,nrows + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = (start(2) - 1 + j - 1) * dims(1) + start(1) + i - 1 + ! Expected value, after reading, is the same as the compdof + exp_val(i,j) = compdof(tmp_idx) + end do + end do + ! pio_decomp_tests_2d.F90.in:317 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:320 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:327)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:328 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:330)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:331 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:333)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:334 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:336)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:337 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:339)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:340 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:343)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:344 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_2d.F90.in:346 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:348)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:349 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:350)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:351 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_2d.F90.in:356 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_2d.F90.in:361 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_2d_row_decomp_PIO_int_integer__ + + +SUBROUTINE nc_write_read_2d_row_decomp_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 2 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_real), dimension(:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, tmp_idx, ierr, lsz, nrows, ncols + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_2d.F90.in:282 + ! Set the decomposition for writing data - forcing rearrangement + call get_2d_row_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + ! pio_decomp_tests_2d.F90.in:287 + allocate(wbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + do j=1,ncols + do i=1,nrows + wbuf(i,j) = (start(2) - 1 + j - 1) * dims(1) + start(1) + i - 1 + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j) + end do + end do + ! pio_decomp_tests_2d.F90.in:297 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:300 + ! Set the decomposition for reading data - different from the write decomp + call get_2d_row_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + + allocate(rbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + allocate(exp_val(nrows, ncols)) + do j=1,ncols + do i=1,nrows + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = (start(2) - 1 + j - 1) * dims(1) + start(1) + i - 1 + ! Expected value, after reading, is the same as the compdof + exp_val(i,j) = compdof(tmp_idx) + end do + end do + ! pio_decomp_tests_2d.F90.in:317 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:320 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:327)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:328 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:330)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:331 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:333)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:334 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:336)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:337 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:339)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:340 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:343)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:344 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_2d.F90.in:346 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:348)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:349 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:350)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:351 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_2d.F90.in:356 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_2d.F90.in:361 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_2d_row_decomp_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_write_read_2d_row_decomp_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 2 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_double), dimension(:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, tmp_idx, ierr, lsz, nrows, ncols + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_2d.F90.in:282 + ! Set the decomposition for writing data - forcing rearrangement + call get_2d_row_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + ! pio_decomp_tests_2d.F90.in:287 + allocate(wbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + do j=1,ncols + do i=1,nrows + wbuf(i,j) = (start(2) - 1 + j - 1) * dims(1) + start(1) + i - 1 + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j) + end do + end do + ! pio_decomp_tests_2d.F90.in:297 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:300 + ! Set the decomposition for reading data - different from the write decomp + call get_2d_row_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + + allocate(rbuf(nrows, ncols)) + allocate(compdof(nrows * ncols)) + allocate(exp_val(nrows, ncols)) + do j=1,ncols + do i=1,nrows + tmp_idx = (j - 1) * nrows + i + compdof(tmp_idx) = (start(2) - 1 + j - 1) * dims(1) + start(1) + i - 1 + ! Expected value, after reading, is the same as the compdof + exp_val(i,j) = compdof(tmp_idx) + end do + end do + ! pio_decomp_tests_2d.F90.in:317 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_2d.F90.in:320 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:327)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:328 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:330)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:331 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:333)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:334 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:336)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:337 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:339)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:340 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:343)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:344 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_2d.F90.in:346 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:348)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:349 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_2d.F90.in:350)" + END IF + RETURN + END IF + ! pio_decomp_tests_2d.F90.in:351 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_2d.F90.in:356 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_2d.F90.in:361 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_2d_row_decomp_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests_2d.F90.in:367 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_col_decomp_PIO_int_integer__" + END IF + CALL nc_write_read_2d_col_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_read_2d_col_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_read_2d_col_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_col_decomp_PIO_int_integer__" + END IF + CALL nc_write_read_2d_col_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_write_read_2d_col_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 4:",& + "nc_write_read_2d_col_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 5:",& + "nc_write_read_2d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 6:",& + "nc_write_read_2d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_row_decomp_PIO_int_integer__" + END IF + CALL nc_write_read_2d_row_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_write_read_2d_row_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 7:",& + "nc_write_read_2d_row_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_row_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_read_2d_row_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_write_read_2d_row_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 8:",& + "nc_write_read_2d_row_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_2d_row_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_read_2d_row_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_write_read_2d_row_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 9:",& + "nc_write_read_2d_row_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_decomp_tests_3d.F90.in2 b/tests/general/pio_decomp_tests_3d.F90.in2 new file mode 100644 index 00000000000..e4ca9da599b --- /dev/null +++ b/tests/general/pio_decomp_tests_3d.F90.in2 @@ -0,0 +1,846 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_decomp_tests_3d.F90.in + +! Get a 3D column decomposition +! If force_rearrange is FALSE, the decomposition is such that +! # All even procs have VEC_HGT_SZ blocks of +! (VEC_COL_SZ rows x VEC_ROW_SZ columns) elements +! # All odd procs have VEC_HGT_SZ blocks of +! (VEC_COL_SZ rows x VEC_ROW_SZ + 1 columns) elements +! e.g. For VEC_ROW_SZ = 2, VEC_COL_SZ = 2, VEC_HGT_SZ = 2 +! and ranks 0, 1, 2, +! e.g. 1) |(1,1,1) (1,2,1) (2,1,1) (2,2,1)| +! |(1,1,2) (1,2,2) (2,1,2) (2,2,2)| , +! |(1,3,1) (1,4,1) (1,5,1) (2,3,1) (2,4,1) (2,5,1)| +! |(1,3,2) (1,4,2) (1,5,2) (2,3,2) (2,4,2) (2,5,2)|, +! |(1,6,1) (1,7,1) (2,6,1) (2,7,1)| +! |(1,6,2) (1,7,2) (2,6,2) (2,7,2)| +! If force_rearrange is TRUE, the decomposition is such that, +! If possible, the even rank "exchanges" elements with the next +! higher ranked odd proc. +! e.g. For VEC_ROW_SZ = 2, VEC_COL_SZ = 2, VEC_HGT_SZ = 2 +! and ranks 0, 1, 2, +! e.g. 1 |(1,3,1) (1,4,1) (1,5,1) (2,3,1) (2,4,1) (2,5,1)| +! |(1,3,2) (1,4,2) (1,5,2) (2,3,2) (2,4,2) (2,5,2)|, +! |(1,1,1) (1,2,1) (2,1,1) (2,2,1)| +! |(1,1,2) (1,2,2) (2,1,2) (2,2,2)| , +! |(1,6,1) (1,7,1) (2,6,1) (2,7,1)| +! |(1,6,2) (1,7,2) (2,6,2) (2,7,2)| +! This for example can be used to force rearrangement when reading +! or writing data. +SUBROUTINE get_3d_col_decomp_info(rank, sz, dims, start, count, force_rearrange) ! pio_decomp_tests_3d.F90.in:28 + integer, parameter :: VEC_ROW_SZ = 2 ! pio_decomp_tests_3d.F90.in:29 + integer, parameter :: VEC_COL_SZ = 2 ! pio_decomp_tests_3d.F90.in:30 + integer, parameter :: VEC_HGT_SZ = 2 ! pio_decomp_tests_3d.F90.in:31 + integer, parameter :: NDIMS = 3 ! pio_decomp_tests_3d.F90.in:32 + integer, intent(in) :: rank ! pio_decomp_tests_3d.F90.in:33 + integer, intent(in) :: sz ! pio_decomp_tests_3d.F90.in:34 + integer, dimension(NDIMS), intent(out) :: dims ! pio_decomp_tests_3d.F90.in:35 + integer, dimension(NDIMS), intent(out) :: start ! pio_decomp_tests_3d.F90.in:36 + integer, dimension(NDIMS), intent(out) :: count ! pio_decomp_tests_3d.F90.in:37 + logical, intent(in) :: force_rearrange ! pio_decomp_tests_3d.F90.in:38 + + + logical :: is_even_rank ! pio_decomp_tests_3d.F90.in:40 + integer :: num_odd_procs, num_even_procs ! pio_decomp_tests_3d.F90.in:41 + integer :: iodd, ieven ! pio_decomp_tests_3d.F90.in:42 + + + is_even_rank = .false. ! pio_decomp_tests_3d.F90.in:44 + if (mod(rank, 2) == 0) then ! pio_decomp_tests_3d.F90.in:45 + is_even_rank = .true. ! pio_decomp_tests_3d.F90.in:46 + end if ! pio_decomp_tests_3d.F90.in:47 + num_odd_procs = sz / 2 ! pio_decomp_tests_3d.F90.in:48 + num_even_procs = sz - num_odd_procs ! pio_decomp_tests_3d.F90.in:49 + dims(1) = VEC_COL_SZ ! pio_decomp_tests_3d.F90.in:50 + dims(2) = num_even_procs * VEC_ROW_SZ + num_odd_procs * (VEC_ROW_SZ + 1) ! pio_decomp_tests_3d.F90.in:51 + dims(3) = VEC_HGT_SZ ! pio_decomp_tests_3d.F90.in:52 + ! Number of odd and even procs before this rank + iodd = rank / 2 ! pio_decomp_tests_3d.F90.in:54 + ieven = (rank + 1) / 2 ! pio_decomp_tests_3d.F90.in:55 + + + ! Rows + start(1) = 1 ! pio_decomp_tests_3d.F90.in:58 + count(1) = VEC_COL_SZ ! pio_decomp_tests_3d.F90.in:59 + + + ! Columns + if(force_rearrange) then ! pio_decomp_tests_3d.F90.in:62 + ! Make sure that we force rearrangement + if (is_even_rank) then ! pio_decomp_tests_3d.F90.in:64 + if(rank + 1 < sz) then ! pio_decomp_tests_3d.F90.in:65 + ! Force rearrangement + count(2) = VEC_ROW_SZ + 1 ! pio_decomp_tests_3d.F90.in:67 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + (VEC_ROW_SZ) + 1 ! pio_decomp_tests_3d.F90.in:68 + else ! pio_decomp_tests_3d.F90.in:69 + count(2) = VEC_ROW_SZ ! pio_decomp_tests_3d.F90.in:70 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + 1 ! pio_decomp_tests_3d.F90.in:71 + end if ! pio_decomp_tests_3d.F90.in:72 + else ! pio_decomp_tests_3d.F90.in:73 + ! For all odd procs there is an even lower ranked, rank-1, proc + ! So force rearrangement + count(2) = VEC_ROW_SZ ! pio_decomp_tests_3d.F90.in:76 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) - (VEC_ROW_SZ) + 1 ! pio_decomp_tests_3d.F90.in:77 + end if ! pio_decomp_tests_3d.F90.in:78 + else ! pio_decomp_tests_3d.F90.in:79 + if (is_even_rank) then ! pio_decomp_tests_3d.F90.in:80 + count(2) = VEC_ROW_SZ ! pio_decomp_tests_3d.F90.in:81 + else ! pio_decomp_tests_3d.F90.in:82 + count(2) = VEC_ROW_SZ + 1 ! pio_decomp_tests_3d.F90.in:83 + end if ! pio_decomp_tests_3d.F90.in:84 + start(2) = ieven * VEC_ROW_SZ + iodd * (VEC_ROW_SZ + 1) + 1 ! pio_decomp_tests_3d.F90.in:85 + end if ! pio_decomp_tests_3d.F90.in:86 + + + ! Height + start(3) = 1 ! pio_decomp_tests_3d.F90.in:89 + count(3) = VEC_HGT_SZ ! pio_decomp_tests_3d.F90.in:90 +END SUBROUTINE ! pio_decomp_tests_3d.F90.in:91 + + +! Write with one decomp (to force rearrangement) and read with another (no +! rearrangement) + + +SUBROUTINE nc_write_read_3d_col_decomp_PIO_int_integer__ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 3 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + integer, dimension(:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_3d.F90.in:113 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts)) + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k) + end do + end do + end do + ! pio_decomp_tests_3d.F90.in:132 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_3d.F90.in:135 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts)) + ! pio_decomp_tests_3d.F90.in:145 + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k) = compdof(tmp_idx) + end do + end do + end do + ! pio_decomp_tests_3d.F90.in:156 + call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_3d.F90.in:159 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_int : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:166)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:167 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:169)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:170 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:172)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:173 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:175)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:176 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_int, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:178)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:179 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:181)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:182 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:185)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:186 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_3d.F90.in:188 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:190)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:191 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:192)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:193 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_3d.F90.in:198 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_3d.F90.in:203 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_3d_col_decomp_PIO_int_integer__ + + +SUBROUTINE nc_write_read_3d_col_decomp_PIO_real_real_kind_fc_real___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 3 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_real), dimension(:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_3d.F90.in:113 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts)) + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k) + end do + end do + end do + ! pio_decomp_tests_3d.F90.in:132 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_3d.F90.in:135 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts)) + ! pio_decomp_tests_3d.F90.in:145 + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k) = compdof(tmp_idx) + end do + end do + end do + ! pio_decomp_tests_3d.F90.in:156 + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_3d.F90.in:159 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_real : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:166)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:167 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:169)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:170 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:172)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:173 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:175)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:176 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_real, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:178)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:179 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:181)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:182 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:185)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:186 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_3d.F90.in:188 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:190)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:191 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:192)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:193 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_3d.F90.in:198 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_3d.F90.in:203 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_3d_col_decomp_PIO_real_real_kind_fc_real___ + + +SUBROUTINE nc_write_read_3d_col_decomp_PIO_double_real_kind_fc_double___ +USE pio_tutil + + implicit none + type(var_desc_t) :: pio_var + type(file_desc_t) :: pio_file + integer, parameter :: NDIMS = 3 + character(len=PIO_TF_MAX_STR_LEN) :: filename + type(io_desc_t) :: wr_iodesc, rd_iodesc + integer, dimension(:), allocatable :: compdof + integer, dimension(NDIMS) :: start, count + real(kind=fc_double), dimension(:,:,:), allocatable :: rbuf, wbuf, exp_val + integer, dimension(NDIMS) :: dims + integer, dimension(NDIMS) :: pio_dims + integer :: i, j, k, tmp_idx, ierr, lsz, nrows, ncols, nhgts + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs + integer :: num_iotypes + ! pio_decomp_tests_3d.F90.in:113 + ! Set the decomposition for writing data - forcing rearrangement + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(wbuf(nrows, ncols, nhgts)) + allocate(compdof(nrows * ncols * nhgts)) + do k=1,nhgts + do j=1,ncols + do i=1,nrows + wbuf(i,j,k) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = wbuf(i,j,k) + end do + end do + end do + ! pio_decomp_tests_3d.F90.in:132 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc) + deallocate(compdof) + ! pio_decomp_tests_3d.F90.in:135 + ! Set the decomposition for reading data - different from the write decomp + call get_3d_col_decomp_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .false.) + nrows = count(1) + ncols = count(2) + nhgts = count(3) + + allocate(rbuf(nrows, ncols, nhgts)) + allocate(compdof(nrows * ncols * nhgts)) + allocate(exp_val(nrows, ncols, nhgts)) + ! pio_decomp_tests_3d.F90.in:145 + do k=1,nhgts + do j=1,ncols + do i=1,nrows + tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i + compdof(tmp_idx) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +& + (start(2) - 1 + j - 1) * dims(1) + i + exp_val(i,j,k) = compdof(tmp_idx) + end do + end do + end do + ! pio_decomp_tests_3d.F90.in:156 + call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc) + deallocate(compdof) + ! pio_decomp_tests_3d.F90.in:159 + num_iotypes = 0 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) + filename = "test_pio_decomp_simple_tests.testfile" + do i=1,num_iotypes + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : PIO_double : ", iotype_descs(i) + END IF + END IF + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:166)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:167 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_row', dims(1), pio_dims(1)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:169)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:170 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_col', dims(2), pio_dims(2)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:172)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:173 + ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_hgt', dims(3), pio_dims(3)) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a dim : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:175)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:176 + ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_double, pio_dims, pio_var) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define a var : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:178)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:179 + ierr = PIO_enddef(pio_file) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to end redef mode : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:181)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:182 + ! Write the variable out + call PIO_write_darray(pio_file, pio_var, wr_iodesc, wbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:185)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:186 + call PIO_syncfile(pio_file) + ! pio_decomp_tests_3d.F90.in:188 + call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf, ierr) + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray : " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:190)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:191 + + IF (.NOT. PIO_TF_Check_val_(rbuf, exp_val)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_decomp_tests_3d.F90.in:192)" + END IF + RETURN + END IF + ! pio_decomp_tests_3d.F90.in:193 + call PIO_closefile(pio_file) + + call PIO_deletefile(pio_tf_iosystem_, filename); + end do + ! pio_decomp_tests_3d.F90.in:198 + if(allocated(iotypes)) then + deallocate(iotypes) + deallocate(iotype_descs) + end if + ! pio_decomp_tests_3d.F90.in:203 + call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc) + call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc) + deallocate(exp_val) + deallocate(rbuf) + deallocate(wbuf) +END SUBROUTINE nc_write_read_3d_col_decomp_PIO_double_real_kind_fc_double___ + ! pio_decomp_tests_3d.F90.in:209 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_3d_col_decomp_PIO_int_integer__" + END IF + CALL nc_write_read_3d_col_decomp_PIO_int_integer__() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_read_3d_col_decomp_PIO_int_integer__","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "nc_write_read_3d_col_decomp_PIO_int_integer__","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_3d_col_decomp_PIO_real_real_kind_fc_real___" + END IF + CALL nc_write_read_3d_col_decomp_PIO_real_real_kind_fc_real___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_read_3d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "nc_write_read_3d_col_decomp_PIO_real_real_kind_fc_real___","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting nc_write_read_3d_col_decomp_PIO_double_real_kind_fc_double___" + END IF + CALL nc_write_read_3d_col_decomp_PIO_double_real_kind_fc_double___() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_read_3d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + "nc_write_read_3d_col_decomp_PIO_double_real_kind_fc_double___","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_file_fail.F90.in2 b/tests/general/pio_file_fail.F90.in2 new file mode 100644 index 00000000000..212833072b8 --- /dev/null +++ b/tests/general/pio_file_fail.F90.in2 @@ -0,0 +1,179 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_file_fail.F90.in + +# 1 "pio_file_fail.F90.in" +SUBROUTINE create_file_always_fail(iotype, filename) + USE pio_tutil + ! pio_file_fail.F90.in:1 + implicit none ! pio_file_fail.F90.in:2 + integer, intent(in) :: iotype ! pio_file_fail.F90.in:3 + character(len=PIO_TF_MAX_STR_LEN), intent(in) :: filename ! pio_file_fail.F90.in:4 + + + type(file_desc_t) :: pio_file ! pio_file_fail.F90.in:6 + integer ierr ! pio_file_fail.F90.in:7 + + + ! Original file creation + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotype, filename) ! pio_file_fail.F90.in:10 + + IF (.NOT. (PIO_TF_Passert_(ierr /= PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "PIO_createfile did not fail as expected",& + ":", __FILE__, ":", __LINE__,& + "(pio_file_fail.F90.in:11)" + END IF + RETURN + END IF ! pio_file_fail.F90.in:11 + + +END SUBROUTINE create_file_always_fail ! pio_file_fail.F90.in:13 + + +# 15 "pio_file_fail.F90.in" +SUBROUTINE open_file_always_fail(iotype, filename) + USE pio_tutil + ! pio_file_fail.F90.in:15 + implicit none ! pio_file_fail.F90.in:16 + integer, intent(in) :: iotype ! pio_file_fail.F90.in:17 + character(len=PIO_TF_MAX_STR_LEN), intent(in) :: filename ! pio_file_fail.F90.in:18 + + + type(file_desc_t) :: pio_file ! pio_file_fail.F90.in:20 + integer ierr ! pio_file_fail.F90.in:21 + + + ! Test opening of file + ierr = PIO_openfile(pio_tf_iosystem_, pio_file, iotype, filename, PIO_nowrite) ! pio_file_fail.F90.in:24 + + IF (.NOT. (PIO_TF_Passert_(ierr /= PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "PIO_openfile did not fail as expected",& + ":", __FILE__, ":", __LINE__,& + "(pio_file_fail.F90.in:25)" + END IF + RETURN + END IF ! pio_file_fail.F90.in:25 + + +END SUBROUTINE open_file_always_fail ! pio_file_fail.F90.in:27 + + +SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + ! pio_file_fail.F90.in:29 + implicit none ! pio_file_fail.F90.in:30 + character(len=PIO_TF_MAX_STR_LEN) :: dummy_file ! pio_file_fail.F90.in:31 + integer :: i ! pio_file_fail.F90.in:32 + ! uiotypes = undefined nc io types + integer, dimension(:), allocatable :: uiotypes ! pio_file_fail.F90.in:34 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: uiotype_descs ! pio_file_fail.F90.in:35 + integer :: num_uiotypes ! pio_file_fail.F90.in:36 + + + num_uiotypes = 0 ! pio_file_fail.F90.in:38 + call PIO_TF_Get_undef_iotypes(uiotypes, uiotype_descs, num_uiotypes) ! pio_file_fail.F90.in:39 + dummy_file = "test_pio_file_fail.testfile" ! pio_file_fail.F90.in:40 + do i=1,num_uiotypes ! pio_file_fail.F90.in:41 + + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="create_file_always_fail"//"("// trim(uiotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting ",& + pio_tf_tmp_log_str_ + END IF + CALL create_file_always_fail(uiotypes(i), dummy_file) + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + pio_tf_tmp_log_str_,& + "--------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + pio_tf_tmp_log_str_,& + "--------", "FAILED" + END IF + END IF ! pio_file_fail.F90.in:42 + + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="open_file_always_fail"//"("// trim(uiotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting ",& + pio_tf_tmp_log_str_ + END IF + CALL open_file_always_fail(uiotypes(i), dummy_file) + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + pio_tf_tmp_log_str_,& + "--------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + pio_tf_tmp_log_str_,& + "--------", "FAILED" + END IF + END IF ! pio_file_fail.F90.in:43 + end do ! pio_file_fail.F90.in:44 + if(allocated(uiotypes)) then ! pio_file_fail.F90.in:45 + deallocate(uiotypes) ! pio_file_fail.F90.in:46 + deallocate(uiotype_descs) ! pio_file_fail.F90.in:47 + end if ! pio_file_fail.F90.in:48 + + + +END SUBROUTINE PIO_TF_Test_driver_ ! pio_file_fail.F90.in:50 + + + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_file_simple_tests.F90.in2 b/tests/general/pio_file_simple_tests.F90.in2 new file mode 100644 index 00000000000..0f59bc0afb1 --- /dev/null +++ b/tests/general/pio_file_simple_tests.F90.in2 @@ -0,0 +1,234 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_file_simple_tests.F90.in + +# 1 "pio_file_simple_tests.F90.in" +SUBROUTINE create_file_no_opts(iotype, filename) + USE pio_tutil + ! pio_file_simple_tests.F90.in:1 + implicit none ! pio_file_simple_tests.F90.in:2 + integer, intent(in) :: iotype ! pio_file_simple_tests.F90.in:3 + character(len=PIO_TF_MAX_STR_LEN), intent(in) :: filename ! pio_file_simple_tests.F90.in:4 + + + type(file_desc_t) :: pio_file ! pio_file_simple_tests.F90.in:6 + integer ierr ! pio_file_simple_tests.F90.in:7 + + + ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotype, filename) ! pio_file_simple_tests.F90.in:9 + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_file_simple_tests.F90.in:10)" + END IF + RETURN + END IF ! pio_file_simple_tests.F90.in:10 + + + ! netcdf files need to end define mode before closing + if (PIO_TF_Is_netcdf(iotype)) then ! pio_file_simple_tests.F90.in:13 + ierr = PIO_enddef(pio_file) ! pio_file_simple_tests.F90.in:14 + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not end define mode: " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_file_simple_tests.F90.in:15)" + END IF + RETURN + END IF ! pio_file_simple_tests.F90.in:15 + end if ! pio_file_simple_tests.F90.in:16 + + + call PIO_closefile(pio_file) ! pio_file_simple_tests.F90.in:18 + + +END SUBROUTINE create_file_no_opts ! pio_file_simple_tests.F90.in:20 + + +# 22 "pio_file_simple_tests.F90.in" +SUBROUTINE open_file_no_write(iotype, filename) + USE pio_tutil + ! pio_file_simple_tests.F90.in:22 + implicit none ! pio_file_simple_tests.F90.in:23 + integer, intent(in) :: iotype ! pio_file_simple_tests.F90.in:24 + character(len=PIO_TF_MAX_STR_LEN), intent(in) :: filename ! pio_file_simple_tests.F90.in:25 + + + type(file_desc_t) :: pio_file ! pio_file_simple_tests.F90.in:27 + integer ierr ! pio_file_simple_tests.F90.in:28 + + + ! Test opening of file + ierr = PIO_openfile(pio_tf_iosystem_, pio_file, iotype, filename, PIO_nowrite) ! pio_file_simple_tests.F90.in:31 + + IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not open " // trim(filename),& + ":", __FILE__, ":", __LINE__,& + "(pio_file_simple_tests.F90.in:32)" + END IF + RETURN + END IF ! pio_file_simple_tests.F90.in:32 + + + ! Close file + call PIO_closefile(pio_file) ! pio_file_simple_tests.F90.in:35 + + +END SUBROUTINE open_file_no_write ! pio_file_simple_tests.F90.in:37 + + +# 39 "pio_file_simple_tests.F90.in" +SUBROUTINE delete_file(filename) + USE pio_tutil + ! pio_file_simple_tests.F90.in:39 + implicit none ! pio_file_simple_tests.F90.in:40 + character(len=PIO_TF_MAX_STR_LEN), intent(in) :: filename ! pio_file_simple_tests.F90.in:41 + + + call PIO_deletefile(pio_tf_iosystem_, filename) ! pio_file_simple_tests.F90.in:43 +END SUBROUTINE delete_file ! pio_file_simple_tests.F90.in:44 + + +SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + ! pio_file_simple_tests.F90.in:46 + implicit none ! pio_file_simple_tests.F90.in:47 + character(len=PIO_TF_MAX_STR_LEN) :: dummy_file ! pio_file_simple_tests.F90.in:48 + integer :: i ! pio_file_simple_tests.F90.in:49 + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes ! pio_file_simple_tests.F90.in:51 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_file_simple_tests.F90.in:52 + integer :: num_iotypes ! pio_file_simple_tests.F90.in:53 + + + num_iotypes = 0 ! pio_file_simple_tests.F90.in:55 + call PIO_TF_Get_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_file_simple_tests.F90.in:56 + dummy_file = "test_pio_file_simple_tests.testfile" ! pio_file_simple_tests.F90.in:57 + do i=1,num_iotypes ! pio_file_simple_tests.F90.in:58 + + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="create_file_no_opts"//"("// trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting ",& + pio_tf_tmp_log_str_ + END IF + CALL create_file_no_opts(iotypes(i), dummy_file) + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + pio_tf_tmp_log_str_,& + "--------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + pio_tf_tmp_log_str_,& + "--------", "FAILED" + END IF + END IF ! pio_file_simple_tests.F90.in:59 + + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="open_file_no_write"//"("// trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting ",& + pio_tf_tmp_log_str_ + END IF + CALL open_file_no_write(iotypes(i), dummy_file) + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + pio_tf_tmp_log_str_,& + "--------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + pio_tf_tmp_log_str_,& + "--------", "FAILED" + END IF + END IF ! pio_file_simple_tests.F90.in:60 + + pio_tf_retval_utest_ = 0 + pio_tf_tmp_log_str_="delete_file"//"("// trim(iotype_descs(i))//")" + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting ",& + pio_tf_tmp_log_str_ + END IF + CALL delete_file(dummy_file) + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + pio_tf_tmp_log_str_,& + "--------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 3:",& + pio_tf_tmp_log_str_,& + "--------", "FAILED" + END IF + END IF ! pio_file_simple_tests.F90.in:61 + end do ! pio_file_simple_tests.F90.in:62 + if(allocated(iotypes)) then ! pio_file_simple_tests.F90.in:63 + deallocate(iotypes) ! pio_file_simple_tests.F90.in:64 + deallocate(iotype_descs) ! pio_file_simple_tests.F90.in:65 + end if ! pio_file_simple_tests.F90.in:66 + + + +END SUBROUTINE PIO_TF_Test_driver_ ! pio_file_simple_tests.F90.in:68 + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_init_finalize.F90.in2 b/tests/general/pio_init_finalize.F90.in2 new file mode 100644 index 00000000000..8f4f968959a --- /dev/null +++ b/tests/general/pio_init_finalize.F90.in2 @@ -0,0 +1,79 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_init_finalize.F90.in + +SUBROUTINE init_finalize + USE pio_tutil + ! pio_init_finalize.F90.in:1 + ! The default test driver should initialize and finalize PIO + PRINT *, "Hello world" ! pio_init_finalize.F90.in:3 +END SUBROUTINE init_finalize ! pio_init_finalize.F90.in:4 + + + + + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting init_finalize" + END IF + CALL init_finalize() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "init_finalize","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "init_finalize","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_iosystem_tests.F90.in2 b/tests/general/pio_iosystem_tests.F90.in2 new file mode 100644 index 00000000000..34441734e46 --- /dev/null +++ b/tests/general/pio_iosystem_tests.F90.in2 @@ -0,0 +1,665 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_iosystem_tests.F90.in + +! Split comm world into two comms (one with even procs and the other +! with odd procs +SUBROUTINE split_world_odd_even(new_comm, new_rank, new_size, is_even) ! pio_iosystem_tests.F90.in:3 + use mpi ! pio_iosystem_tests.F90.in:4 + use pio_tutil ! pio_iosystem_tests.F90.in:5 + implicit none ! pio_iosystem_tests.F90.in:6 + integer, intent(inout) :: new_comm ! pio_iosystem_tests.F90.in:7 + integer, intent(inout) :: new_rank ! pio_iosystem_tests.F90.in:8 + integer, intent(inout) :: new_size ! pio_iosystem_tests.F90.in:9 + logical, intent(inout) :: is_even ! pio_iosystem_tests.F90.in:10 + + + integer :: ierr ! pio_iosystem_tests.F90.in:12 + integer :: color ! pio_iosystem_tests.F90.in:13 + + + new_comm = MPI_COMM_NULL ! pio_iosystem_tests.F90.in:15 + new_rank = 0 ! pio_iosystem_tests.F90.in:16 + new_size = 0 ! pio_iosystem_tests.F90.in:17 + + + if(mod(pio_tf_world_rank_, 2) == 0) then ! pio_iosystem_tests.F90.in:19 + is_even = .true. ! pio_iosystem_tests.F90.in:20 + color = 1 ! pio_iosystem_tests.F90.in:21 + else ! pio_iosystem_tests.F90.in:22 + is_even = .false. ! pio_iosystem_tests.F90.in:23 + color = 0 ! pio_iosystem_tests.F90.in:24 + end if ! pio_iosystem_tests.F90.in:25 + + + call MPI_Comm_split(pio_tf_comm_, color, 0, new_comm, ierr) ! pio_iosystem_tests.F90.in:27 + + + call MPI_Comm_rank(new_comm, new_rank, ierr) ! pio_iosystem_tests.F90.in:29 + call MPI_Comm_size(new_comm, new_size, ierr) ! pio_iosystem_tests.F90.in:30 +END SUBROUTINE split_world_odd_even ! pio_iosystem_tests.F90.in:31 + + +SUBROUTINE split_world_only_even(new_comm, new_rank, new_size, is_even) ! pio_iosystem_tests.F90.in:33 + use mpi ! pio_iosystem_tests.F90.in:34 + use pio_tutil ! pio_iosystem_tests.F90.in:35 + implicit none ! pio_iosystem_tests.F90.in:36 + integer, intent(inout) :: new_comm ! pio_iosystem_tests.F90.in:37 + integer, intent(inout) :: new_rank ! pio_iosystem_tests.F90.in:38 + integer, intent(inout) :: new_size ! pio_iosystem_tests.F90.in:39 + logical, intent(inout) :: is_even ! pio_iosystem_tests.F90.in:40 + + + integer :: ierr ! pio_iosystem_tests.F90.in:42 + integer :: color ! pio_iosystem_tests.F90.in:43 + + + new_comm = MPI_COMM_NULL ! pio_iosystem_tests.F90.in:45 + new_rank = 0 ! pio_iosystem_tests.F90.in:46 + new_size = 0 ! pio_iosystem_tests.F90.in:47 + + + if(mod(pio_tf_world_rank_, 2) == 0) then ! pio_iosystem_tests.F90.in:49 + is_even = .true. ! pio_iosystem_tests.F90.in:50 + color = 1 ! pio_iosystem_tests.F90.in:51 + else ! pio_iosystem_tests.F90.in:52 + is_even = .false. ! pio_iosystem_tests.F90.in:53 + color = MPI_UNDEFINED ! pio_iosystem_tests.F90.in:54 + end if ! pio_iosystem_tests.F90.in:55 + + + call MPI_Comm_split(pio_tf_comm_, color, 0, new_comm, ierr) ! pio_iosystem_tests.F90.in:57 + + + if(new_comm /= MPI_COMM_NULL) then ! pio_iosystem_tests.F90.in:59 + call MPI_Comm_rank(new_comm, new_rank, ierr) ! pio_iosystem_tests.F90.in:60 + call MPI_Comm_size(new_comm, new_size, ierr) ! pio_iosystem_tests.F90.in:61 + end if ! pio_iosystem_tests.F90.in:62 +END SUBROUTINE split_world_only_even ! pio_iosystem_tests.F90.in:63 + + +! Create a file with a global attribute (filename) +SUBROUTINE create_file(comm, iosys, iotype, fname, attname, dimname, ret) ! pio_iosystem_tests.F90.in:66 + use pio_tutil ! pio_iosystem_tests.F90.in:67 + implicit none ! pio_iosystem_tests.F90.in:68 + + + integer, intent(in) :: comm ! pio_iosystem_tests.F90.in:70 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests.F90.in:71 + integer, intent(in) :: iotype ! pio_iosystem_tests.F90.in:72 + character(len=*), intent(in) :: fname ! pio_iosystem_tests.F90.in:73 + character(len=*), intent(in) :: attname ! pio_iosystem_tests.F90.in:74 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests.F90.in:75 + integer, intent(inout) :: ret ! pio_iosystem_tests.F90.in:76 + + + type(file_desc_t) :: pio_file ! pio_iosystem_tests.F90.in:78 + integer :: pio_dim ! pio_iosystem_tests.F90.in:79 + type(var_desc_t) :: pio_var ! pio_iosystem_tests.F90.in:80 + + + ret = PIO_createfile(iosys, pio_file, iotype, fname, PIO_CLOBBER) ! pio_iosystem_tests.F90.in:82 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create dummy file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:83)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:83 + + + ret = PIO_def_dim(pio_file, dimname, PIO_TF_MAX_STR_LEN, pio_dim) ! pio_iosystem_tests.F90.in:85 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim "// trim(dimname) // "in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:86)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:86 + + + ret = PIO_def_var(pio_file, attname, PIO_char, (/pio_dim/), pio_var) ! pio_iosystem_tests.F90.in:88 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:89)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:89 + + + ret = PIO_put_att(pio_file, pio_var, attname, fname) ! pio_iosystem_tests.F90.in:91 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put att " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:92)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:92 + + + call PIO_closefile(pio_file) ! pio_iosystem_tests.F90.in:94 +END SUBROUTINE create_file ! pio_iosystem_tests.F90.in:95 + + +! Check the contents of file : Check the +! global attribute 'filename' (should be equal to the +! name of the file, fname) +SUBROUTINE check_file(comm, iosys, iotype, pio_file, fname, attname, dimname, ret) ! pio_iosystem_tests.F90.in:100 + use pio_tutil ! pio_iosystem_tests.F90.in:101 + implicit none ! pio_iosystem_tests.F90.in:102 + + + integer, intent(in) :: comm ! pio_iosystem_tests.F90.in:104 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests.F90.in:105 + integer, intent(in) :: iotype ! pio_iosystem_tests.F90.in:106 + type(file_desc_t), intent(inout) :: pio_file ! pio_iosystem_tests.F90.in:107 + character(len=*), intent(in) :: fname ! pio_iosystem_tests.F90.in:108 + character(len=*), intent(in) :: attname ! pio_iosystem_tests.F90.in:109 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests.F90.in:110 + integer, intent(inout) :: ret ! pio_iosystem_tests.F90.in:111 + + + integer :: pio_dim ! pio_iosystem_tests.F90.in:113 + type(var_desc_t) :: pio_var ! pio_iosystem_tests.F90.in:114 + character(len=PIO_TF_MAX_STR_LEN) :: val ! pio_iosystem_tests.F90.in:115 + + + ret = PIO_inq_dimid(pio_file, dimname, pio_dim) ! pio_iosystem_tests.F90.in:117 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to find dim "// trim(dimname) // "in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:118)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:118 + + + ret = PIO_inq_varid(pio_file, attname, pio_var) ! pio_iosystem_tests.F90.in:120 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to find var " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:121)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:121 + + + ret = PIO_get_att(pio_file, pio_var, attname, val) ! pio_iosystem_tests.F90.in:123 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get att " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:124)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:124 + + + PRINT *, "val = ", trim(val), ", fname =", trim(fname) ! pio_iosystem_tests.F90.in:126 + + IF (.NOT. (PIO_TF_Passert_(val .eq. fname, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Attribute value is not the expected value",& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:127)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:127 +END SUBROUTINE check_file ! pio_iosystem_tests.F90.in:128 + + +! Open and check the contents of file : open it and check the +! global attribute 'filename' (should be equal to the +! name of the file, fname) +SUBROUTINE open_and_check_file(comm, iosys, iotype, pio_file, fname, & + attname, dimname, disable_fclose, ret) ! pio_iosystem_tests.F90.in:134 + use pio_tutil ! pio_iosystem_tests.F90.in:135 + implicit none ! pio_iosystem_tests.F90.in:136 + + + integer, intent(in) :: comm ! pio_iosystem_tests.F90.in:138 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests.F90.in:139 + integer, intent(in) :: iotype ! pio_iosystem_tests.F90.in:140 + type(file_desc_t), intent(inout) :: pio_file ! pio_iosystem_tests.F90.in:141 + character(len=*), intent(in) :: fname ! pio_iosystem_tests.F90.in:142 + character(len=*), intent(in) :: attname ! pio_iosystem_tests.F90.in:143 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests.F90.in:144 + logical, intent(in) :: disable_fclose ! pio_iosystem_tests.F90.in:145 + integer, intent(inout) :: ret ! pio_iosystem_tests.F90.in:146 + + + ret = PIO_openfile(iosys, pio_file, iotype, fname, PIO_write) ! pio_iosystem_tests.F90.in:148 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:149)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:149 + + + call check_file(comm, iosys, iotype, pio_file, fname, attname, dimname, ret) ! pio_iosystem_tests.F90.in:151 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:152)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:152 + + + if(.not. disable_fclose) then ! pio_iosystem_tests.F90.in:154 + call PIO_closefile(pio_file) ! pio_iosystem_tests.F90.in:155 + end if ! pio_iosystem_tests.F90.in:156 +END SUBROUTINE open_and_check_file ! pio_iosystem_tests.F90.in:157 + + +! Create a file with one iosystem - with all procs, and open/read with +! another iosystem - subset (odd/even) of procs +SUBROUTINE two_iosystems_odd_even + USE pio_tutil + ! pio_iosystem_tests.F90.in:161 + implicit none ! pio_iosystem_tests.F90.in:162 + + + character(len=PIO_TF_MAX_STR_LEN), target :: fname1 = "pio_iosys_test_file1.nc" ! pio_iosystem_tests.F90.in:164 + character(len=PIO_TF_MAX_STR_LEN), target :: fname2 = "pio_iosys_test_file2.nc" ! pio_iosystem_tests.F90.in:165 + character(len=PIO_TF_MAX_STR_LEN), parameter :: attname = "filename" ! pio_iosystem_tests.F90.in:166 + character(len=PIO_TF_MAX_STR_LEN), parameter :: dimname = "filename_dim" ! pio_iosystem_tests.F90.in:167 + character(len=PIO_TF_MAX_STR_LEN), pointer :: fname ! pio_iosystem_tests.F90.in:168 + integer, dimension(:), allocatable :: iotypes ! pio_iosystem_tests.F90.in:169 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_iosystem_tests.F90.in:170 + integer :: i, num_iotypes = 0 ! pio_iosystem_tests.F90.in:171 + type(file_desc_t) :: pio_file ! pio_iosystem_tests.F90.in:172 + + + type(iosystem_desc_t) :: odd_even_iosys ! pio_iosystem_tests.F90.in:174 + integer :: odd_even_comm, odd_even_comm_rank, odd_even_comm_size ! pio_iosystem_tests.F90.in:175 + logical :: is_even ! pio_iosystem_tests.F90.in:176 + integer :: ret ! pio_iosystem_tests.F90.in:177 + + + ! Split world to odd and even procs + call split_world_odd_even(odd_even_comm, odd_even_comm_rank, odd_even_comm_size, is_even) ! pio_iosystem_tests.F90.in:180 + + + call PIO_init(odd_even_comm_rank, odd_even_comm, odd_even_comm_size, & + 1, &! Num aggregators + 1, &! Stride + PIO_rearr_subset, odd_even_iosys, base=0) ! pio_iosystem_tests.F90.in:185 + call PIO_seterrorhandling(odd_even_iosys, PIO_BCAST_ERROR) ! pio_iosystem_tests.F90.in:186 + + + ! Open two different files and close it with two different iosystems + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_iosystem_tests.F90.in:189 + do i=1,num_iotypes ! pio_iosystem_tests.F90.in:190 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : ", iotype_descs(i) + END IF + END IF ! pio_iosystem_tests.F90.in:191 + ! Create two files to be opened later - world - all procs + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname1, attname, dimname, ret) ! pio_iosystem_tests.F90.in:194 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname1,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:195)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:195 + + + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname2, attname, dimname, ret) ! pio_iosystem_tests.F90.in:198 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname2,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:199)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:199 + + + ! Open file1 from odd processes and file2 from even processes + if(is_even) then ! pio_iosystem_tests.F90.in:202 + fname => fname1 ! pio_iosystem_tests.F90.in:203 + else ! pio_iosystem_tests.F90.in:204 + fname => fname2 ! pio_iosystem_tests.F90.in:205 + end if ! pio_iosystem_tests.F90.in:206 + + + call open_and_check_file(odd_even_comm, odd_even_iosys, iotypes(i), & + pio_file, fname, attname, dimname, .false., ret) ! pio_iosystem_tests.F90.in:209 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:210)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:210 + end do ! pio_iosystem_tests.F90.in:211 + + + call PIO_finalize(odd_even_iosys, ret) ! pio_iosystem_tests.F90.in:213 + call MPI_Comm_free(odd_even_comm, ret) ! pio_iosystem_tests.F90.in:214 + if(allocated(iotypes)) then ! pio_iosystem_tests.F90.in:215 + deallocate(iotypes) ! pio_iosystem_tests.F90.in:216 + deallocate(iotype_descs) ! pio_iosystem_tests.F90.in:217 + end if ! pio_iosystem_tests.F90.in:218 +END SUBROUTINE two_iosystems_odd_even ! pio_iosystem_tests.F90.in:219 + + +! Create a file with one iosystem - with all procs, and open/read with +! two iosystems - (1) with all procs (2) subset (even) of procs +SUBROUTINE two_iosystems_even_all + USE pio_tutil + ! pio_iosystem_tests.F90.in:223 + implicit none ! pio_iosystem_tests.F90.in:224 + + + character(len=PIO_TF_MAX_STR_LEN), target :: fname1 = "pio_iosys_test_file1.nc" ! pio_iosystem_tests.F90.in:226 + character(len=PIO_TF_MAX_STR_LEN), target :: fname2 = "pio_iosys_test_file2.nc" ! pio_iosystem_tests.F90.in:227 + character(len=PIO_TF_MAX_STR_LEN), parameter :: attname = "filename" ! pio_iosystem_tests.F90.in:228 + character(len=PIO_TF_MAX_STR_LEN), parameter :: dimname = "filename_dim" ! pio_iosystem_tests.F90.in:229 + character(len=PIO_TF_MAX_STR_LEN), pointer :: fname ! pio_iosystem_tests.F90.in:230 + integer, dimension(:), allocatable :: iotypes ! pio_iosystem_tests.F90.in:231 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_iosystem_tests.F90.in:232 + integer :: i, num_iotypes = 0 ! pio_iosystem_tests.F90.in:233 + type(file_desc_t) :: pio_file1, pio_file2 ! pio_iosystem_tests.F90.in:234 + + + type(iosystem_desc_t) :: odd_even_iosys ! pio_iosystem_tests.F90.in:236 + integer :: odd_even_comm, odd_even_comm_rank, odd_even_comm_size ! pio_iosystem_tests.F90.in:237 + logical :: is_even ! pio_iosystem_tests.F90.in:238 + logical :: disable_fclose = .true. ! pio_iosystem_tests.F90.in:239 + integer :: ret ! pio_iosystem_tests.F90.in:240 + + + ! Split world to odd and even procs + call split_world_only_even(odd_even_comm, odd_even_comm_rank, odd_even_comm_size, is_even) ! pio_iosystem_tests.F90.in:243 + + + if(is_even) then ! pio_iosystem_tests.F90.in:245 + call PIO_init(odd_even_comm_rank, odd_even_comm, odd_even_comm_size, & + 1, &! Num aggregators + 1, &! Stride + PIO_rearr_subset, odd_even_iosys, base=0) ! pio_iosystem_tests.F90.in:249 + call PIO_seterrorhandling(odd_even_iosys, PIO_BCAST_ERROR) ! pio_iosystem_tests.F90.in:250 + end if ! pio_iosystem_tests.F90.in:251 + + + ! Open two different files and close it with two different iosystems + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_iosystem_tests.F90.in:254 + do i=1,num_iotypes ! pio_iosystem_tests.F90.in:255 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : ", iotype_descs(i) + END IF + END IF ! pio_iosystem_tests.F90.in:256 + ! Create two files to be opened later - world - all procs + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname1, attname, dimname, ret) ! pio_iosystem_tests.F90.in:259 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname1,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:260)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:260 + + + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname2, attname, dimname, ret) ! pio_iosystem_tests.F90.in:263 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname2,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:264)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:264 + + + ! Open file1 from all even processes and file2 from all odd processes + ! - PIO called from all processes with the odd_even_iosys + if(is_even) then ! pio_iosystem_tests.F90.in:268 + call open_and_check_file(odd_even_comm, odd_even_iosys, iotypes(i), & + pio_file1, fname1, attname, dimname, disable_fclose, ret) ! pio_iosystem_tests.F90.in:270 + PRINT *, "file1,", trim(fname1), "fh: ", pio_file1%fh ! pio_iosystem_tests.F90.in:271 + end if ! pio_iosystem_tests.F90.in:272 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname1,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:273)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:273 + + + call open_and_check_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + pio_file2, fname2, attname, dimname, disable_fclose, ret) ! pio_iosystem_tests.F90.in:276 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname2,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:277)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:277 + PRINT *, "file2,", trim(fname2), "fh: ", pio_file2%fh ! pio_iosystem_tests.F90.in:278 + + + ! Check contents of the files again + ! - PIO called from odd and even processes separately with odd_even_iosys + if(is_even) then ! pio_iosystem_tests.F90.in:282 + call check_file(odd_even_comm, odd_even_iosys, iotypes(i), pio_file1, & + fname1, attname, dimname, ret) ! pio_iosystem_tests.F90.in:284 + !call PIO_closefile(pio_file1) + end if ! pio_iosystem_tests.F90.in:286 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname1,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:287)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:287 + + + call check_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), pio_file2, & + fname2, attname, dimname, ret) ! pio_iosystem_tests.F90.in:290 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname2,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests.F90.in:291)" + END IF + RETURN + END IF ! pio_iosystem_tests.F90.in:291 + + + if(disable_fclose) then ! pio_iosystem_tests.F90.in:293 + if(is_even) then ! pio_iosystem_tests.F90.in:294 + call PIO_closefile(pio_file1) ! pio_iosystem_tests.F90.in:295 + end if ! pio_iosystem_tests.F90.in:296 + call PIO_closefile(pio_file2) ! pio_iosystem_tests.F90.in:297 + end if ! pio_iosystem_tests.F90.in:298 + end do ! pio_iosystem_tests.F90.in:299 + + + if(is_even) then ! pio_iosystem_tests.F90.in:301 + call PIO_finalize(odd_even_iosys, ret) ! pio_iosystem_tests.F90.in:302 + call MPI_Comm_free(odd_even_comm, ret) ! pio_iosystem_tests.F90.in:303 + end if ! pio_iosystem_tests.F90.in:304 + if(allocated(iotypes)) then ! pio_iosystem_tests.F90.in:305 + deallocate(iotypes) ! pio_iosystem_tests.F90.in:306 + deallocate(iotype_descs) ! pio_iosystem_tests.F90.in:307 + end if ! pio_iosystem_tests.F90.in:308 +END SUBROUTINE two_iosystems_even_all ! pio_iosystem_tests.F90.in:309 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting two_iosystems_odd_even" + END IF + CALL two_iosystems_odd_even() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "two_iosystems_odd_even","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "two_iosystems_odd_even","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting two_iosystems_even_all" + END IF + CALL two_iosystems_even_all() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "two_iosystems_even_all","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "two_iosystems_even_all","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_iosystem_tests2.F90.in2 b/tests/general/pio_iosystem_tests2.F90.in2 new file mode 100644 index 00000000000..955c67684f0 --- /dev/null +++ b/tests/general/pio_iosystem_tests2.F90.in2 @@ -0,0 +1,530 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_iosystem_tests2.F90.in + +! Split comm world into two comms (one with even procs and the other +! with odd procs +SUBROUTINE split_world_odd_even(new_comm, new_rank, new_size, is_even) ! pio_iosystem_tests2.F90.in:3 + use mpi ! pio_iosystem_tests2.F90.in:4 + use pio_tutil ! pio_iosystem_tests2.F90.in:5 + implicit none ! pio_iosystem_tests2.F90.in:6 + integer, intent(inout) :: new_comm ! pio_iosystem_tests2.F90.in:7 + integer, intent(inout) :: new_rank ! pio_iosystem_tests2.F90.in:8 + integer, intent(inout) :: new_size ! pio_iosystem_tests2.F90.in:9 + logical, intent(inout) :: is_even ! pio_iosystem_tests2.F90.in:10 + + + integer :: ierr ! pio_iosystem_tests2.F90.in:12 + integer :: color ! pio_iosystem_tests2.F90.in:13 + + + new_comm = MPI_COMM_NULL ! pio_iosystem_tests2.F90.in:15 + new_rank = 0 ! pio_iosystem_tests2.F90.in:16 + new_size = 0 ! pio_iosystem_tests2.F90.in:17 + + + if(mod(pio_tf_world_rank_, 2) == 0) then ! pio_iosystem_tests2.F90.in:19 + is_even = .true. ! pio_iosystem_tests2.F90.in:20 + color = 1 ! pio_iosystem_tests2.F90.in:21 + else ! pio_iosystem_tests2.F90.in:22 + is_even = .false. ! pio_iosystem_tests2.F90.in:23 + color = 0 ! pio_iosystem_tests2.F90.in:24 + end if ! pio_iosystem_tests2.F90.in:25 + + + call MPI_Comm_split(pio_tf_comm_, color, 0, new_comm, ierr) ! pio_iosystem_tests2.F90.in:27 + + + call MPI_Comm_rank(new_comm, new_rank, ierr) ! pio_iosystem_tests2.F90.in:29 + call MPI_Comm_size(new_comm, new_size, ierr) ! pio_iosystem_tests2.F90.in:30 +END SUBROUTINE split_world_odd_even ! pio_iosystem_tests2.F90.in:31 + + +SUBROUTINE split_world_only_even(new_comm, new_rank, new_size, is_even) ! pio_iosystem_tests2.F90.in:33 + use mpi ! pio_iosystem_tests2.F90.in:34 + use pio_tutil ! pio_iosystem_tests2.F90.in:35 + implicit none ! pio_iosystem_tests2.F90.in:36 + integer, intent(inout) :: new_comm ! pio_iosystem_tests2.F90.in:37 + integer, intent(inout) :: new_rank ! pio_iosystem_tests2.F90.in:38 + integer, intent(inout) :: new_size ! pio_iosystem_tests2.F90.in:39 + logical, intent(inout) :: is_even ! pio_iosystem_tests2.F90.in:40 + + + integer :: ierr ! pio_iosystem_tests2.F90.in:42 + integer :: color ! pio_iosystem_tests2.F90.in:43 + + + new_comm = MPI_COMM_NULL ! pio_iosystem_tests2.F90.in:45 + new_rank = 0 ! pio_iosystem_tests2.F90.in:46 + new_size = 0 ! pio_iosystem_tests2.F90.in:47 + + + if(mod(pio_tf_world_rank_, 2) == 0) then ! pio_iosystem_tests2.F90.in:49 + is_even = .true. ! pio_iosystem_tests2.F90.in:50 + color = 1 ! pio_iosystem_tests2.F90.in:51 + else ! pio_iosystem_tests2.F90.in:52 + is_even = .false. ! pio_iosystem_tests2.F90.in:53 + color = MPI_UNDEFINED ! pio_iosystem_tests2.F90.in:54 + end if ! pio_iosystem_tests2.F90.in:55 + + + call MPI_Comm_split(pio_tf_comm_, color, 0, new_comm, ierr) ! pio_iosystem_tests2.F90.in:57 + + + if(new_comm /= MPI_COMM_NULL) then ! pio_iosystem_tests2.F90.in:59 + call MPI_Comm_rank(new_comm, new_rank, ierr) ! pio_iosystem_tests2.F90.in:60 + call MPI_Comm_size(new_comm, new_size, ierr) ! pio_iosystem_tests2.F90.in:61 + end if ! pio_iosystem_tests2.F90.in:62 +END SUBROUTINE split_world_only_even ! pio_iosystem_tests2.F90.in:63 + + +! Create a file with a global attribute (filename) +SUBROUTINE create_file(comm, iosys, iotype, fname, attname, dimname, ret) ! pio_iosystem_tests2.F90.in:66 + use pio_tutil ! pio_iosystem_tests2.F90.in:67 + implicit none ! pio_iosystem_tests2.F90.in:68 + + + integer, intent(in) :: comm ! pio_iosystem_tests2.F90.in:70 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests2.F90.in:71 + integer, intent(in) :: iotype ! pio_iosystem_tests2.F90.in:72 + character(len=*), intent(in) :: fname ! pio_iosystem_tests2.F90.in:73 + character(len=*), intent(in) :: attname ! pio_iosystem_tests2.F90.in:74 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests2.F90.in:75 + integer, intent(inout) :: ret ! pio_iosystem_tests2.F90.in:76 + + + type(file_desc_t) :: pio_file ! pio_iosystem_tests2.F90.in:78 + integer :: pio_dim ! pio_iosystem_tests2.F90.in:79 + type(var_desc_t) :: pio_var ! pio_iosystem_tests2.F90.in:80 + + + ret = PIO_createfile(iosys, pio_file, iotype, fname, PIO_CLOBBER) ! pio_iosystem_tests2.F90.in:82 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create dummy file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:83)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:83 + + + ret = PIO_def_dim(pio_file, dimname, PIO_TF_MAX_STR_LEN, pio_dim) ! pio_iosystem_tests2.F90.in:85 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim "// trim(dimname) // "in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:86)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:86 + + + ret = PIO_def_var(pio_file, attname, PIO_char, (/pio_dim/), pio_var) ! pio_iosystem_tests2.F90.in:88 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:89)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:89 + + + ret = PIO_put_att(pio_file, pio_var, attname, fname) ! pio_iosystem_tests2.F90.in:91 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put att " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:92)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:92 + + + call PIO_closefile(pio_file) ! pio_iosystem_tests2.F90.in:94 +END SUBROUTINE create_file ! pio_iosystem_tests2.F90.in:95 + + +! Check the contents of file : Check the +! global attribute 'filename' (should be equal to the +! name of the file, fname) +SUBROUTINE check_file(comm, iosys, iotype, pio_file, fname, attname, dimname, ret) ! pio_iosystem_tests2.F90.in:100 + use pio_tutil ! pio_iosystem_tests2.F90.in:101 + implicit none ! pio_iosystem_tests2.F90.in:102 + + + integer, intent(in) :: comm ! pio_iosystem_tests2.F90.in:104 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests2.F90.in:105 + integer, intent(in) :: iotype ! pio_iosystem_tests2.F90.in:106 + type(file_desc_t), intent(inout) :: pio_file ! pio_iosystem_tests2.F90.in:107 + character(len=*), intent(in) :: fname ! pio_iosystem_tests2.F90.in:108 + character(len=*), intent(in) :: attname ! pio_iosystem_tests2.F90.in:109 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests2.F90.in:110 + integer, intent(inout) :: ret ! pio_iosystem_tests2.F90.in:111 + + + integer :: pio_dim ! pio_iosystem_tests2.F90.in:113 + type(var_desc_t) :: pio_var ! pio_iosystem_tests2.F90.in:114 + character(len=PIO_TF_MAX_STR_LEN) :: val ! pio_iosystem_tests2.F90.in:115 + + + ret = PIO_inq_dimid(pio_file, dimname, pio_dim) ! pio_iosystem_tests2.F90.in:117 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to find dim "// trim(dimname) // "in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:118)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:118 + + + ret = PIO_inq_varid(pio_file, attname, pio_var) ! pio_iosystem_tests2.F90.in:120 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to find var " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:121)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:121 + + + ret = PIO_get_att(pio_file, pio_var, attname, val) ! pio_iosystem_tests2.F90.in:123 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get att " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:124)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:124 + + + PRINT *, "val = ", trim(val), ", fname =", trim(fname) ! pio_iosystem_tests2.F90.in:126 + + IF (.NOT. (PIO_TF_Passert_(val .eq. fname, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Attribute value is not the expected value",& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:127)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:127 +END SUBROUTINE check_file ! pio_iosystem_tests2.F90.in:128 + + +! Open and check the contents of file : open it and check the +! global attribute 'filename' (should be equal to the +! name of the file, fname) +SUBROUTINE open_and_check_file(comm, iosys, iotype, pio_file, fname, & + attname, dimname, disable_fclose, ret) ! pio_iosystem_tests2.F90.in:134 + use pio_tutil ! pio_iosystem_tests2.F90.in:135 + implicit none ! pio_iosystem_tests2.F90.in:136 + + + integer, intent(in) :: comm ! pio_iosystem_tests2.F90.in:138 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests2.F90.in:139 + integer, intent(in) :: iotype ! pio_iosystem_tests2.F90.in:140 + type(file_desc_t), intent(inout) :: pio_file ! pio_iosystem_tests2.F90.in:141 + character(len=*), intent(in) :: fname ! pio_iosystem_tests2.F90.in:142 + character(len=*), intent(in) :: attname ! pio_iosystem_tests2.F90.in:143 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests2.F90.in:144 + logical, intent(in) :: disable_fclose ! pio_iosystem_tests2.F90.in:145 + integer, intent(inout) :: ret ! pio_iosystem_tests2.F90.in:146 + + + ret = PIO_openfile(iosys, pio_file, iotype, fname, PIO_write) ! pio_iosystem_tests2.F90.in:148 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:149)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:149 + + + call check_file(comm, iosys, iotype, pio_file, fname, attname, dimname, ret) ! pio_iosystem_tests2.F90.in:151 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:152)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:152 + + + if(.not. disable_fclose) then ! pio_iosystem_tests2.F90.in:154 + call PIO_closefile(pio_file) ! pio_iosystem_tests2.F90.in:155 + end if ! pio_iosystem_tests2.F90.in:156 +END SUBROUTINE open_and_check_file ! pio_iosystem_tests2.F90.in:157 + + +! Create three files with one iosystem - with all procs, and open/read with +! another iosystem - subset (odd/even) of procs +SUBROUTINE three_files_two_iosystems_odd_even + USE pio_tutil + ! pio_iosystem_tests2.F90.in:161 + implicit none ! pio_iosystem_tests2.F90.in:162 + + + character(len=PIO_TF_MAX_STR_LEN), target :: fname0 = "pio_iosys_test_file0.nc" ! pio_iosystem_tests2.F90.in:164 + character(len=PIO_TF_MAX_STR_LEN), target :: fname1 = "pio_iosys_test_file1.nc" ! pio_iosystem_tests2.F90.in:165 + character(len=PIO_TF_MAX_STR_LEN), target :: fname2 = "pio_iosys_test_file2.nc" ! pio_iosystem_tests2.F90.in:166 + character(len=PIO_TF_MAX_STR_LEN), parameter :: attname = "filename" ! pio_iosystem_tests2.F90.in:167 + character(len=PIO_TF_MAX_STR_LEN), parameter :: dimname = "filename_dim" ! pio_iosystem_tests2.F90.in:168 + character(len=PIO_TF_MAX_STR_LEN), pointer :: fname ! pio_iosystem_tests2.F90.in:169 + integer, dimension(:), allocatable :: iotypes ! pio_iosystem_tests2.F90.in:170 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_iosystem_tests2.F90.in:171 + integer :: i, num_iotypes = 0 ! pio_iosystem_tests2.F90.in:172 + type(file_desc_t) :: pio_file0, pio_file ! pio_iosystem_tests2.F90.in:173 + + + type(iosystem_desc_t) :: odd_even_iosys ! pio_iosystem_tests2.F90.in:175 + integer :: odd_even_comm, odd_even_comm_rank, odd_even_comm_size ! pio_iosystem_tests2.F90.in:176 + logical :: is_even ! pio_iosystem_tests2.F90.in:177 + integer :: ret ! pio_iosystem_tests2.F90.in:178 + + + ! Split world to odd and even procs + call split_world_odd_even(odd_even_comm, odd_even_comm_rank, odd_even_comm_size, is_even) ! pio_iosystem_tests2.F90.in:181 + + + call PIO_init(odd_even_comm_rank, odd_even_comm, odd_even_comm_size, & + 1, &! Num aggregators + 1, &! Stride + PIO_rearr_subset, odd_even_iosys, base=0) ! pio_iosystem_tests2.F90.in:186 + call PIO_seterrorhandling(odd_even_iosys, PIO_BCAST_ERROR) ! pio_iosystem_tests2.F90.in:187 + + + ! Open two different files and close it with two different iosystems + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_iosystem_tests2.F90.in:190 + do i=1,num_iotypes ! pio_iosystem_tests2.F90.in:191 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : ", iotype_descs(i) + END IF + END IF ! pio_iosystem_tests2.F90.in:192 + ! Create three files to be opened later - world - all procs + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname0, attname, dimname, ret) ! pio_iosystem_tests2.F90.in:195 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname0,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:196)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:196 + + + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname1, attname, dimname, ret) ! pio_iosystem_tests2.F90.in:199 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname1,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:200)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:200 + + + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname2, attname, dimname, ret) ! pio_iosystem_tests2.F90.in:203 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname2,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:204)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:204 + + + ! Open file0 from all procs - disable close + call open_and_check_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + pio_file0, fname0, attname, dimname, .true., ret) ! pio_iosystem_tests2.F90.in:208 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname0,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:209)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:209 + + + ! Open file1 from odd processes and file2 from even processes + ! - disable close + if(is_even) then ! pio_iosystem_tests2.F90.in:213 + fname => fname1 ! pio_iosystem_tests2.F90.in:214 + else ! pio_iosystem_tests2.F90.in:215 + fname => fname2 ! pio_iosystem_tests2.F90.in:216 + end if ! pio_iosystem_tests2.F90.in:217 + + + call open_and_check_file(odd_even_comm, odd_even_iosys, iotypes(i), & + pio_file, fname, attname, dimname, .true., ret) ! pio_iosystem_tests2.F90.in:220 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:221)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:221 + + + ! Make sure that we can still check the contents of the file + call check_file(odd_even_comm, odd_even_iosys, iotypes(i), pio_file, & + fname, attname, dimname, ret) ! pio_iosystem_tests2.F90.in:225 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking (second) contents of file failed :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests2.F90.in:226)" + END IF + RETURN + END IF ! pio_iosystem_tests2.F90.in:226 + + + call PIO_closefile(pio_file) ! pio_iosystem_tests2.F90.in:228 + call PIO_closefile(pio_file0) ! pio_iosystem_tests2.F90.in:229 + end do ! pio_iosystem_tests2.F90.in:230 + + + call PIO_finalize(odd_even_iosys, ret) ! pio_iosystem_tests2.F90.in:232 + call MPI_Comm_free(odd_even_comm, ret) ! pio_iosystem_tests2.F90.in:233 + if(allocated(iotypes)) then ! pio_iosystem_tests2.F90.in:234 + deallocate(iotypes) ! pio_iosystem_tests2.F90.in:235 + deallocate(iotype_descs) ! pio_iosystem_tests2.F90.in:236 + end if ! pio_iosystem_tests2.F90.in:237 +END SUBROUTINE three_files_two_iosystems_odd_even ! pio_iosystem_tests2.F90.in:238 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting three_files_two_iosystems_odd_even" + END IF + CALL three_files_two_iosystems_odd_even() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "three_files_two_iosystems_odd_even","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "three_files_two_iosystems_odd_even","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_iosystem_tests3.F90.in2 b/tests/general/pio_iosystem_tests3.F90.in2 new file mode 100644 index 00000000000..3ea5a3d9a97 --- /dev/null +++ b/tests/general/pio_iosystem_tests3.F90.in2 @@ -0,0 +1,576 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_iosystem_tests3.F90.in + +! Split comm world into two comms (even procs and odd procs) and +! rank == overlapped_rank included in both comms +SUBROUTINE split_world_two_with_overlap(new_comms, new_ranks, new_sizes, overlapped_rank) ! pio_iosystem_tests3.F90.in:3 + use mpi ! pio_iosystem_tests3.F90.in:4 + use pio_tutil ! pio_iosystem_tests3.F90.in:5 + implicit none ! pio_iosystem_tests3.F90.in:6 + integer, parameter :: NUM_COMMS = 2 ! pio_iosystem_tests3.F90.in:7 + integer, dimension(NUM_COMMS), intent(inout) :: new_comms ! pio_iosystem_tests3.F90.in:8 + integer, dimension(NUM_COMMS), intent(inout) :: new_ranks ! pio_iosystem_tests3.F90.in:9 + integer, dimension(NUM_COMMS), intent(inout) :: new_sizes ! pio_iosystem_tests3.F90.in:10 + integer, intent(in) :: overlapped_rank ! pio_iosystem_tests3.F90.in:11 + + + integer :: i, ierr ! pio_iosystem_tests3.F90.in:13 + integer :: world_group ! pio_iosystem_tests3.F90.in:14 + ! first group range (first rank, last rank, stride) for including rank=overlapped_rank + ! second group range (first rank, last rank, stride) for other procs + ! strided depending on number of comms + ! Note: NUM_GROUP_RANGES is always 2, indep of value of NUM_COMMS + integer, parameter :: NUM_GROUP_RANGES = 2 ! pio_iosystem_tests3.F90.in:19 + integer :: nranges ! pio_iosystem_tests3.F90.in:20 + integer, dimension(3,NUM_GROUP_RANGES) :: new_group_ranges ! pio_iosystem_tests3.F90.in:21 + integer, dimension(NUM_COMMS) :: new_groups ! pio_iosystem_tests3.F90.in:22 + + + do i=1,NUM_COMMS ! pio_iosystem_tests3.F90.in:24 + new_comms(i) = MPI_COMM_NULL ! pio_iosystem_tests3.F90.in:25 + new_ranks(i) = -1 ! pio_iosystem_tests3.F90.in:26 + new_sizes(i) = 0 ! pio_iosystem_tests3.F90.in:27 + end do ! pio_iosystem_tests3.F90.in:28 + + + call MPI_Comm_group(pio_tf_comm_, world_group, ierr) ! pio_iosystem_tests3.F90.in:30 + + + do i=1,NUM_COMMS ! pio_iosystem_tests3.F90.in:32 + if(pio_tf_world_sz_ == 1) then ! pio_iosystem_tests3.F90.in:33 + nranges = 1 ! pio_iosystem_tests3.F90.in:34 + new_group_ranges(1,1) = overlapped_rank ! pio_iosystem_tests3.F90.in:35 + new_group_ranges(2,1) = overlapped_rank ! pio_iosystem_tests3.F90.in:36 + new_group_ranges(3,1) = 1 ! pio_iosystem_tests3.F90.in:37 + else if(overlapped_rank / NUM_COMMS /= i-1) then ! pio_iosystem_tests3.F90.in:38 + nranges = 2 ! pio_iosystem_tests3.F90.in:39 + ! Include rank == overlapped_rank + new_group_ranges(1,1) = overlapped_rank ! pio_iosystem_tests3.F90.in:41 + new_group_ranges(2,1) = overlapped_rank ! pio_iosystem_tests3.F90.in:42 + new_group_ranges(3,1) = 1 ! pio_iosystem_tests3.F90.in:43 + + + ! Include other processes split evenly among NUM_COMMS + new_group_ranges(1,2) = i-1 ! pio_iosystem_tests3.F90.in:46 + new_group_ranges(2,2) = i-1 + (pio_tf_world_sz_/NUM_COMMS - 1) * NUM_COMMS ! pio_iosystem_tests3.F90.in:47 + new_group_ranges(3,2) = NUM_COMMS ! pio_iosystem_tests3.F90.in:48 + else ! pio_iosystem_tests3.F90.in:49 + nranges = 1 ! pio_iosystem_tests3.F90.in:50 + ! Include processes split evenly among NUM_COMMS + ! rank == overlapped_rank is already included in this range + new_group_ranges(1,1) = i-1 ! pio_iosystem_tests3.F90.in:53 + new_group_ranges(2,1) = i-1 + (pio_tf_world_sz_/NUM_COMMS - 1) * NUM_COMMS ! pio_iosystem_tests3.F90.in:54 + new_group_ranges(3,1) = NUM_COMMS ! pio_iosystem_tests3.F90.in:55 + end if ! pio_iosystem_tests3.F90.in:56 + + + call MPI_Group_range_incl(world_group, nranges, new_group_ranges,& + new_groups(i), ierr) ! pio_iosystem_tests3.F90.in:59 + end do ! pio_iosystem_tests3.F90.in:60 + + + call MPI_Group_free(world_group, ierr) ! pio_iosystem_tests3.F90.in:62 + + + ! Create communicators corresponding to the groups + ! All the communicators will have rank == overlapped_rank and are + ! disjoint otherwise + do i=1,NUM_COMMS ! pio_iosystem_tests3.F90.in:67 + call MPI_Comm_create(pio_tf_comm_, new_groups(i), new_comms(i), ierr) ! pio_iosystem_tests3.F90.in:68 + call MPI_Group_free(new_groups(i), ierr) ! pio_iosystem_tests3.F90.in:69 + if(new_comms(i) /= MPI_COMM_NULL) then ! pio_iosystem_tests3.F90.in:70 + call MPI_Comm_rank(new_comms(i), new_ranks(i), ierr) ! pio_iosystem_tests3.F90.in:71 + call MPI_Comm_size(new_comms(i), new_sizes(i), ierr) ! pio_iosystem_tests3.F90.in:72 + else ! pio_iosystem_tests3.F90.in:73 + new_ranks(i) = -1 ! pio_iosystem_tests3.F90.in:74 + new_sizes(i) = 0 ! pio_iosystem_tests3.F90.in:75 + end if ! pio_iosystem_tests3.F90.in:76 + end do ! pio_iosystem_tests3.F90.in:77 + + +END SUBROUTINE split_world_two_with_overlap ! pio_iosystem_tests3.F90.in:79 + + +! Create a file with a global attribute (filename) +SUBROUTINE create_file(comm, iosys, iotype, fname, attname, dimname, ret) ! pio_iosystem_tests3.F90.in:82 + use pio_tutil ! pio_iosystem_tests3.F90.in:83 + implicit none ! pio_iosystem_tests3.F90.in:84 + + + integer, intent(in) :: comm ! pio_iosystem_tests3.F90.in:86 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests3.F90.in:87 + integer, intent(in) :: iotype ! pio_iosystem_tests3.F90.in:88 + character(len=*), intent(in) :: fname ! pio_iosystem_tests3.F90.in:89 + character(len=*), intent(in) :: attname ! pio_iosystem_tests3.F90.in:90 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests3.F90.in:91 + integer, intent(inout) :: ret ! pio_iosystem_tests3.F90.in:92 + + + type(file_desc_t) :: pio_file ! pio_iosystem_tests3.F90.in:94 + integer :: pio_dim ! pio_iosystem_tests3.F90.in:95 + type(var_desc_t) :: pio_var ! pio_iosystem_tests3.F90.in:96 + + + ret = PIO_createfile(iosys, pio_file, iotype, fname, PIO_CLOBBER) ! pio_iosystem_tests3.F90.in:98 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create dummy file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:99)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:99 + + + ret = PIO_def_dim(pio_file, dimname, PIO_TF_MAX_STR_LEN, pio_dim) ! pio_iosystem_tests3.F90.in:101 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim "// trim(dimname) // "in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:102)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:102 + + + ret = PIO_def_var(pio_file, attname, PIO_char, (/pio_dim/), pio_var) ! pio_iosystem_tests3.F90.in:104 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:105)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:105 + + + ret = PIO_put_att(pio_file, pio_var, attname, fname) ! pio_iosystem_tests3.F90.in:107 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put att " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:108)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:108 + + + call PIO_closefile(pio_file) ! pio_iosystem_tests3.F90.in:110 +END SUBROUTINE create_file ! pio_iosystem_tests3.F90.in:111 + + +! Check the contents of file : Check the +! global attribute 'filename' (should be equal to the +! name of the file, fname) +SUBROUTINE check_file(comm, iosys, iotype, pio_file, fname, attname, dimname, ret) ! pio_iosystem_tests3.F90.in:116 + use pio_tutil ! pio_iosystem_tests3.F90.in:117 + implicit none ! pio_iosystem_tests3.F90.in:118 + + + integer, intent(in) :: comm ! pio_iosystem_tests3.F90.in:120 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests3.F90.in:121 + integer, intent(in) :: iotype ! pio_iosystem_tests3.F90.in:122 + type(file_desc_t), intent(inout) :: pio_file ! pio_iosystem_tests3.F90.in:123 + character(len=*), intent(in) :: fname ! pio_iosystem_tests3.F90.in:124 + character(len=*), intent(in) :: attname ! pio_iosystem_tests3.F90.in:125 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests3.F90.in:126 + integer, intent(inout) :: ret ! pio_iosystem_tests3.F90.in:127 + + + integer :: pio_dim ! pio_iosystem_tests3.F90.in:129 + type(var_desc_t) :: pio_var ! pio_iosystem_tests3.F90.in:130 + character(len=PIO_TF_MAX_STR_LEN) :: val ! pio_iosystem_tests3.F90.in:131 + + + ret = PIO_inq_dimid(pio_file, dimname, pio_dim) ! pio_iosystem_tests3.F90.in:133 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to find dim "// trim(dimname) // "in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:134)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:134 + + + ret = PIO_inq_varid(pio_file, attname, pio_var) ! pio_iosystem_tests3.F90.in:136 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to find var " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:137)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:137 + + + ret = PIO_get_att(pio_file, pio_var, attname, val) ! pio_iosystem_tests3.F90.in:139 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to get att " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:140)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:140 + + + PRINT *, "val = ", trim(val), ", fname =", trim(fname) ! pio_iosystem_tests3.F90.in:142 + + IF (.NOT. (PIO_TF_Passert_(val .eq. fname, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: Assertion failed :",& + "Attribute value is not the expected value",& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:143)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:143 +END SUBROUTINE check_file ! pio_iosystem_tests3.F90.in:144 + + +! Open and check the contents of file : open it and check the +! global attribute 'filename' (should be equal to the +! name of the file, fname) +SUBROUTINE open_and_check_file(comm, iosys, iotype, pio_file, fname, & + attname, dimname, disable_fclose, ret) ! pio_iosystem_tests3.F90.in:150 + use pio_tutil ! pio_iosystem_tests3.F90.in:151 + implicit none ! pio_iosystem_tests3.F90.in:152 + + + integer, intent(in) :: comm ! pio_iosystem_tests3.F90.in:154 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_iosystem_tests3.F90.in:155 + integer, intent(in) :: iotype ! pio_iosystem_tests3.F90.in:156 + type(file_desc_t), intent(inout) :: pio_file ! pio_iosystem_tests3.F90.in:157 + character(len=*), intent(in) :: fname ! pio_iosystem_tests3.F90.in:158 + character(len=*), intent(in) :: attname ! pio_iosystem_tests3.F90.in:159 + character(len=*), intent(in) :: dimname ! pio_iosystem_tests3.F90.in:160 + logical, intent(in) :: disable_fclose ! pio_iosystem_tests3.F90.in:161 + integer, intent(inout) :: ret ! pio_iosystem_tests3.F90.in:162 + + + ret = PIO_openfile(iosys, pio_file, iotype, fname, PIO_write) ! pio_iosystem_tests3.F90.in:164 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:165)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:165 + + + call check_file(comm, iosys, iotype, pio_file, fname, attname, dimname, ret) ! pio_iosystem_tests3.F90.in:167 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:168)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:168 + + + if(.not. disable_fclose) then ! pio_iosystem_tests3.F90.in:170 + call PIO_closefile(pio_file) ! pio_iosystem_tests3.F90.in:171 + end if ! pio_iosystem_tests3.F90.in:172 +END SUBROUTINE open_and_check_file ! pio_iosystem_tests3.F90.in:173 + + +! Create three files with one iosystem - with all procs, and open/read with +! two different iosystems - subset (odd/even) of procs +! The two iosystems created overlap at rank=0 (and are disjoint otherwise) +SUBROUTINE three_files_two_iosystems_with_overlap + USE pio_tutil + ! pio_iosystem_tests3.F90.in:178 + use mpi ! pio_iosystem_tests3.F90.in:179 + implicit none ! pio_iosystem_tests3.F90.in:180 + + + character(len=PIO_TF_MAX_STR_LEN), target :: fname0 = "pio_iosys_test_file0.nc" ! pio_iosystem_tests3.F90.in:182 + character(len=PIO_TF_MAX_STR_LEN), target :: fname1 = "pio_iosys_test_file1.nc" ! pio_iosystem_tests3.F90.in:183 + character(len=PIO_TF_MAX_STR_LEN), target :: fname2 = "pio_iosys_test_file2.nc" ! pio_iosystem_tests3.F90.in:184 + character(len=PIO_TF_MAX_STR_LEN), parameter :: attname = "filename" ! pio_iosystem_tests3.F90.in:185 + character(len=PIO_TF_MAX_STR_LEN), parameter :: dimname = "filename_dim" ! pio_iosystem_tests3.F90.in:186 + character(len=PIO_TF_MAX_STR_LEN), pointer :: fname ! pio_iosystem_tests3.F90.in:187 + integer, dimension(:), allocatable :: iotypes ! pio_iosystem_tests3.F90.in:188 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_iosystem_tests3.F90.in:189 + integer :: i, j, num_iotypes = 0 ! pio_iosystem_tests3.F90.in:190 + type(file_desc_t) :: pio_file0 ! pio_iosystem_tests3.F90.in:191 + integer, parameter :: NUM_COMMS = 2 ! pio_iosystem_tests3.F90.in:192 + type(file_desc_t), dimension(NUM_COMMS) :: pio_files ! pio_iosystem_tests3.F90.in:193 + integer :: pio_base_rank = 0, pio_num_iotasks = 0 ! pio_iosystem_tests3.F90.in:194 + + + type(iosystem_desc_t), dimension(NUM_COMMS) :: overlapped_iosys ! pio_iosystem_tests3.F90.in:196 + integer, dimension(NUM_COMMS) :: overlapped_comms, overlapped_comm_ranks, overlapped_comm_sizes ! pio_iosystem_tests3.F90.in:197 + integer :: ret ! pio_iosystem_tests3.F90.in:198 + + + ! Split world to two disjoint comms with overlap only at overlapped_rank=0 + call split_world_two_with_overlap(overlapped_comms, overlapped_comm_ranks, overlapped_comm_sizes, 0) ! pio_iosystem_tests3.F90.in:201 + + + do i=1,NUM_COMMS ! pio_iosystem_tests3.F90.in:203 + if(overlapped_comms(i) /= MPI_COMM_NULL) then ! pio_iosystem_tests3.F90.in:204 + ! If we have more than 1 proc, make sure that the io tasks start from 1 + ! since rank=0 is always shared by all the overlapped_comms above + if(overlapped_comm_sizes(i) > 1) then ! pio_iosystem_tests3.F90.in:207 + pio_base_rank = 1 ! pio_iosystem_tests3.F90.in:208 + pio_num_iotasks = overlapped_comm_sizes(i) - 1 ! pio_iosystem_tests3.F90.in:209 + else ! pio_iosystem_tests3.F90.in:210 + pio_base_rank = 0 ! pio_iosystem_tests3.F90.in:211 + pio_num_iotasks = overlapped_comm_sizes(i) ! pio_iosystem_tests3.F90.in:212 + end if ! pio_iosystem_tests3.F90.in:213 + call PIO_init(overlapped_comm_ranks(i), overlapped_comms(i), & + pio_num_iotasks, & + 1, &! Num aggregators + 1, &! Stride + PIO_rearr_subset, overlapped_iosys(i), base=pio_base_rank) ! pio_iosystem_tests3.F90.in:218 + call PIO_seterrorhandling(overlapped_iosys(i), PIO_BCAST_ERROR) ! pio_iosystem_tests3.F90.in:219 + end if ! pio_iosystem_tests3.F90.in:220 + end do ! pio_iosystem_tests3.F90.in:221 + + + ! Open two different files and close it with two different iosystems + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_iosystem_tests3.F90.in:224 + do i=1,num_iotypes ! pio_iosystem_tests3.F90.in:225 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : ", iotype_descs(i) + END IF + END IF ! pio_iosystem_tests3.F90.in:226 + ! Create three files to be opened later - world - all procs + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname0, attname, dimname, ret) ! pio_iosystem_tests3.F90.in:229 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname0,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:230)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:230 + + + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname1, attname, dimname, ret) ! pio_iosystem_tests3.F90.in:233 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname1,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:234)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:234 + + + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname2, attname, dimname, ret) ! pio_iosystem_tests3.F90.in:237 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname2,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:238)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:238 + + + ! Open file0 from all procs - disable close + call open_and_check_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + pio_file0, fname0, attname, dimname, .true., ret) ! pio_iosystem_tests3.F90.in:242 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname0,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:243)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:243 + + + fname => fname1 ! pio_iosystem_tests3.F90.in:245 + + + do j=1,NUM_COMMS ! pio_iosystem_tests3.F90.in:247 + ! The two comms operate on different files + if(fname == fname1) then ! pio_iosystem_tests3.F90.in:249 + fname => fname2 ! pio_iosystem_tests3.F90.in:250 + else ! pio_iosystem_tests3.F90.in:251 + fname => fname1 ! pio_iosystem_tests3.F90.in:252 + end if ! pio_iosystem_tests3.F90.in:253 + if(overlapped_comms(j) /= MPI_COMM_NULL) then ! pio_iosystem_tests3.F90.in:254 + call open_and_check_file(overlapped_comms(j), overlapped_iosys(j), iotypes(i), & + pio_files(j), fname, attname, dimname, .true., ret) ! pio_iosystem_tests3.F90.in:256 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, overlapped_comms(j)))) THEN + call MPI_COMM_RANK( overlapped_comms(j), pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking contents of file failed :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:257)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:257 + + + ! Make sure that we can still check the contents of the file + call check_file(overlapped_comms(j), overlapped_iosys(j), iotypes(i), & + pio_files(j), fname, attname, dimname, ret) ! pio_iosystem_tests3.F90.in:261 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, overlapped_comms(j)))) THEN + call MPI_COMM_RANK( overlapped_comms(j), pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking (second) contents of file failed :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_iosystem_tests3.F90.in:262)" + END IF + RETURN + END IF ! pio_iosystem_tests3.F90.in:262 + end if ! pio_iosystem_tests3.F90.in:263 + end do ! pio_iosystem_tests3.F90.in:264 + + + do j=1,NUM_COMMS ! pio_iosystem_tests3.F90.in:266 + if(overlapped_comms(j) /= MPI_COMM_NULL) then ! pio_iosystem_tests3.F90.in:267 + call PIO_closefile(pio_files(j)) ! pio_iosystem_tests3.F90.in:268 + end if ! pio_iosystem_tests3.F90.in:269 + end do ! pio_iosystem_tests3.F90.in:270 + call PIO_closefile(pio_file0) ! pio_iosystem_tests3.F90.in:271 + end do ! pio_iosystem_tests3.F90.in:272 + + + do i=1,NUM_COMMS ! pio_iosystem_tests3.F90.in:274 + if(overlapped_comms(i) /= MPI_COMM_NULL) then ! pio_iosystem_tests3.F90.in:275 + call PIO_finalize(overlapped_iosys(i), ret) ! pio_iosystem_tests3.F90.in:276 + call MPI_Comm_free(overlapped_comms(i), ret) ! pio_iosystem_tests3.F90.in:277 + end if ! pio_iosystem_tests3.F90.in:278 + end do ! pio_iosystem_tests3.F90.in:279 + if(allocated(iotypes)) then ! pio_iosystem_tests3.F90.in:280 + deallocate(iotypes) ! pio_iosystem_tests3.F90.in:281 + deallocate(iotype_descs) ! pio_iosystem_tests3.F90.in:282 + end if ! pio_iosystem_tests3.F90.in:283 +END SUBROUTINE three_files_two_iosystems_with_overlap ! pio_iosystem_tests3.F90.in:284 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting three_files_two_iosystems_with_overlap" + END IF + CALL three_files_two_iosystems_with_overlap() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "three_files_two_iosystems_with_overlap","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "three_files_two_iosystems_with_overlap","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_rearr.F90.in2 b/tests/general/pio_rearr.F90.in2 new file mode 100644 index 00000000000..d9b1c46c1ba --- /dev/null +++ b/tests/general/pio_rearr.F90.in2 @@ -0,0 +1,623 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_rearr.F90.in + +! Create a file with a global attribute (filename) +SUBROUTINE create_file(comm, iosys, iotype, fname, attname, dimname, ret) ! pio_rearr.F90.in:2 + use pio_tutil ! pio_rearr.F90.in:3 + implicit none ! pio_rearr.F90.in:4 + + + integer, intent(in) :: comm ! pio_rearr.F90.in:6 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_rearr.F90.in:7 + integer, intent(in) :: iotype ! pio_rearr.F90.in:8 + character(len=*), intent(in) :: fname ! pio_rearr.F90.in:9 + character(len=*), intent(in) :: attname ! pio_rearr.F90.in:10 + character(len=*), intent(in) :: dimname ! pio_rearr.F90.in:11 + integer, intent(inout) :: ret ! pio_rearr.F90.in:12 + + + type(file_desc_t) :: pio_file ! pio_rearr.F90.in:14 + integer :: pio_dim ! pio_rearr.F90.in:15 + type(var_desc_t) :: pio_var ! pio_rearr.F90.in:16 + + + ret = PIO_createfile(iosys, pio_file, iotype, fname, PIO_CLOBBER) ! pio_rearr.F90.in:18 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create dummy file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:19)" + END IF + RETURN + END IF ! pio_rearr.F90.in:19 + + + ret = PIO_def_dim(pio_file, dimname, PIO_TF_MAX_STR_LEN, pio_dim) ! pio_rearr.F90.in:21 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim "// trim(dimname) // "in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:22)" + END IF + RETURN + END IF ! pio_rearr.F90.in:22 + + + ret = PIO_def_var(pio_file, attname, PIO_char, (/pio_dim/), pio_var) ! pio_rearr.F90.in:24 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:25)" + END IF + RETURN + END IF ! pio_rearr.F90.in:25 + + + ret = PIO_put_att(pio_file, pio_var, attname, fname) ! pio_rearr.F90.in:27 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to put att " // trim(attname) // " in file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:28)" + END IF + RETURN + END IF ! pio_rearr.F90.in:28 + + + ret = PIO_enddef(pio_file) ! pio_rearr.F90.in:30 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef, file :" // trim(fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:31)" + END IF + RETURN + END IF ! pio_rearr.F90.in:31 + + + call PIO_closefile(pio_file) ! pio_rearr.F90.in:33 +END SUBROUTINE create_file ! pio_rearr.F90.in:34 + + +! Open a file and perform read and write +SUBROUTINE open_and_check_rdwr(comm, iosys, iotype, pio_file, fname, ret) ! pio_rearr.F90.in:37 + use pio_tutil ! pio_rearr.F90.in:38 + implicit none ! pio_rearr.F90.in:39 + + + integer, intent(in) :: comm ! pio_rearr.F90.in:41 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_rearr.F90.in:42 + integer, intent(in) :: iotype ! pio_rearr.F90.in:43 + type(file_desc_t), intent(inout) :: pio_file ! pio_rearr.F90.in:44 + character(len=*), intent(in) :: fname ! pio_rearr.F90.in:45 + integer, intent(inout) :: ret ! pio_rearr.F90.in:46 + + + integer, parameter :: VEC_LOCAL_SZ = 3 ! pio_rearr.F90.in:48 + character(len=PIO_TF_MAX_STR_LEN) :: var_name = "test_1d_var" ! pio_rearr.F90.in:49 + character(len=PIO_TF_MAX_STR_LEN) :: dim_name = "test_dim_1d_var" ! pio_rearr.F90.in:50 + type(var_desc_t) :: pio_var ! pio_rearr.F90.in:51 + type(io_desc_t) :: iodesc ! pio_rearr.F90.in:52 + integer, dimension(VEC_LOCAL_SZ) :: compdof, compdof_rel_disps ! pio_rearr.F90.in:53 + integer :: start_compdof ! pio_rearr.F90.in:54 + real, dimension(VEC_LOCAL_SZ) :: wbuf ! pio_rearr.F90.in:55 + real, dimension(:), allocatable :: rbuf ! pio_rearr.F90.in:56 + integer, dimension(1) :: dims ! pio_rearr.F90.in:57 + integer :: pio_dim ! pio_rearr.F90.in:58 + integer :: comm_rank, comm_sz ! pio_rearr.F90.in:59 + integer :: i ! pio_rearr.F90.in:60 + + + call MPI_Comm_size(comm, comm_sz, ret) ! pio_rearr.F90.in:62 + call MPI_Comm_rank(comm, comm_rank, ret) ! pio_rearr.F90.in:63 + + + dims(1) = VEC_LOCAL_SZ * comm_sz ! pio_rearr.F90.in:65 + + + ret = PIO_openfile(iosys, pio_file, iotype, fname, PIO_write) ! pio_rearr.F90.in:67 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to open:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:68)" + END IF + RETURN + END IF ! pio_rearr.F90.in:68 + + + ret = pio_inq_dimid(pio_file, dim_name, pio_dim) ! pio_rearr.F90.in:70 + if(ret /= PIO_NOERR) then ! pio_rearr.F90.in:71 + ! Define the required dim/var + ret = PIO_redef(pio_file) ! pio_rearr.F90.in:73 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to redef:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:74)" + END IF + RETURN + END IF ! pio_rearr.F90.in:74 + + + ret = PIO_def_dim(pio_file, dim_name, dims(1), pio_dim) ! pio_rearr.F90.in:76 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:77)" + END IF + RETURN + END IF ! pio_rearr.F90.in:77 + + + ! Assume var is not defined either + ret = PIO_def_var(pio_file, var_name, pio_real, (/pio_dim/), pio_var) ! pio_rearr.F90.in:80 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:81)" + END IF + RETURN + END IF ! pio_rearr.F90.in:81 + + + ret = PIO_enddef(pio_file) ! pio_rearr.F90.in:83 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:84)" + END IF + RETURN + END IF ! pio_rearr.F90.in:84 + else ! pio_rearr.F90.in:85 + ! Assume var was also defined + ret = PIO_inq_varid(pio_file, var_name, pio_var) ! pio_rearr.F90.in:87 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to inq var:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:88)" + END IF + RETURN + END IF ! pio_rearr.F90.in:88 + end if ! pio_rearr.F90.in:89 + + + ! Compdof is a simple reverse (of chunks of VEC_LOCAL_SZ) of the file offsets + ! e.g. VEC_LOCAL_SZ = 3, with 2 procs + ! [4 5 6] [1 2 3] + start_compdof = (comm_sz - comm_rank - 1) * VEC_LOCAL_SZ ! pio_rearr.F90.in:94 + do i=1,VEC_LOCAL_SZ ! pio_rearr.F90.in:95 + compdof_rel_disps(i) = i ! pio_rearr.F90.in:96 + end do ! pio_rearr.F90.in:97 + + + compdof = start_compdof + compdof_rel_disps ! pio_rearr.F90.in:99 + wbuf = compdof ! pio_rearr.F90.in:100 + allocate(rbuf(size(wbuf))) ! pio_rearr.F90.in:101 + rbuf = 0 ! pio_rearr.F90.in:102 + + + call PIO_initdecomp(iosys, pio_real, dims, compdof, iodesc) ! pio_rearr.F90.in:104 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to init decomp:" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:105)" + END IF + RETURN + END IF ! pio_rearr.F90.in:105 + + + ! Write and read back the data + call PIO_write_darray(pio_file, pio_var, iodesc, wbuf, ret) ! pio_rearr.F90.in:108 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to write darray: " // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:109)" + END IF + RETURN + END IF ! pio_rearr.F90.in:109 + + + call PIO_syncfile(pio_file) ! pio_rearr.F90.in:111 + + + call PIO_read_darray(pio_file, pio_var, iodesc, rbuf, ret) ! pio_rearr.F90.in:113 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, comm))) THEN + call MPI_COMM_RANK( comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to read darray: " // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:114)" + END IF + RETURN + END IF ! pio_rearr.F90.in:114 + + + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:116)" + END IF + RETURN + END IF ! pio_rearr.F90.in:116 + + + deallocate(rbuf) ! pio_rearr.F90.in:118 + + + call PIO_freedecomp(iosys, iodesc) ! pio_rearr.F90.in:120 + + + call PIO_closefile(pio_file) ! pio_rearr.F90.in:122 +END SUBROUTINE open_and_check_rdwr ! pio_rearr.F90.in:123 + + +SUBROUTINE test_rearrs_base + USE pio_tutil + ! pio_rearr.F90.in:125 + implicit none ! pio_rearr.F90.in:126 + + + character(len=PIO_TF_MAX_STR_LEN), target :: fname = "pio_test_rearrs_base.nc" ! pio_rearr.F90.in:128 + character(len=PIO_TF_MAX_STR_LEN), parameter :: attname = "filename" ! pio_rearr.F90.in:129 + character(len=PIO_TF_MAX_STR_LEN), parameter :: dimname = "filename_dim" ! pio_rearr.F90.in:130 + integer, parameter :: NUM_REARRANGERS = 2 ! pio_rearr.F90.in:131 + integer :: rearrs(NUM_REARRANGERS) = (/pio_rearr_subset,pio_rearr_box/) ! pio_rearr.F90.in:132 + character(len=PIO_TF_MAX_STR_LEN) :: rearrs_info(NUM_REARRANGERS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) ! pio_rearr.F90.in:133 + integer, dimension(:), allocatable :: iotypes ! pio_rearr.F90.in:134 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_rearr.F90.in:135 + integer :: i, j, k, num_iotypes = 0 ! pio_rearr.F90.in:136 + type(file_desc_t) :: pio_file ! pio_rearr.F90.in:137 + + + type(iosystem_desc_t) :: dup_iosys ! pio_rearr.F90.in:139 + integer :: dup_comm ! pio_rearr.F90.in:140 + integer :: dup_comm_rank, dup_comm_sz, dup_iosys_base ! pio_rearr.F90.in:141 + integer :: ret ! pio_rearr.F90.in:142 + + + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_rearr.F90.in:144 + do i=1,num_iotypes ! pio_rearr.F90.in:145 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing iotype: ", iotype_descs(i) + END IF + END IF ! pio_rearr.F90.in:146 + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname, attname, dimname, ret) ! pio_rearr.F90.in:148 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + call MPI_COMM_RANK( pio_tf_comm_, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:149)" + END IF + RETURN + END IF ! pio_rearr.F90.in:149 + + + call MPI_Comm_dup(pio_tf_comm_, dup_comm, ret) ! pio_rearr.F90.in:151 + call MPI_Comm_rank(dup_comm, dup_comm_rank, ret) ! pio_rearr.F90.in:152 + call MPI_Comm_size(dup_comm, dup_comm_sz, ret) ! pio_rearr.F90.in:153 + do j=1, NUM_REARRANGERS ! pio_rearr.F90.in:154 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing rearr : ", rearrs_info(j) + END IF + END IF ! pio_rearr.F90.in:155 + do k=1, dup_comm_sz ! pio_rearr.F90.in:156 + dup_iosys_base = k-1 ! pio_rearr.F90.in:157 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Base = ", dup_iosys_base + END IF + END IF ! pio_rearr.F90.in:158 + call PIO_init(pio_tf_world_rank_, dup_comm, pio_tf_world_sz_, & + 1, &! Num aggregators + 1, &! Stride + rearrs(j), dup_iosys, base=dup_iosys_base) ! pio_rearr.F90.in:162 + call PIO_seterrorhandling(dup_iosys, PIO_BCAST_ERROR) ! pio_rearr.F90.in:163 + + + call open_and_check_rdwr(dup_comm, dup_iosys, iotypes(i), & + pio_file, fname, ret) ! pio_rearr.F90.in:166 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, dup_comm))) THEN + call MPI_COMM_RANK( dup_comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking rd+wr on file failed :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:167)" + END IF + RETURN + END IF ! pio_rearr.F90.in:167 + + + call PIO_finalize(dup_iosys, ret) ! pio_rearr.F90.in:169 + end do ! pio_rearr.F90.in:170 + end do ! pio_rearr.F90.in:171 + call PIO_deletefile(pio_tf_iosystem_, fname) ! pio_rearr.F90.in:172 + call MPI_Comm_free(dup_comm, ret) ! pio_rearr.F90.in:173 + end do ! pio_rearr.F90.in:174 + if(allocated(iotypes)) then ! pio_rearr.F90.in:175 + deallocate(iotypes) ! pio_rearr.F90.in:176 + deallocate(iotype_descs) ! pio_rearr.F90.in:177 + end if ! pio_rearr.F90.in:178 +END SUBROUTINE test_rearrs_base ! pio_rearr.F90.in:179 + + +! Test different combinations of the rearrangers to test the compatibility +! between different rearrangers +! init/rd+wr/finalize with one rearranger followed by another and try +! all combinations ((subset,box),(box_subset),(box,box),(subset,subset)) +SUBROUTINE test_rearrs_combs + USE pio_tutil + ! pio_rearr.F90.in:185 + implicit none ! pio_rearr.F90.in:186 + + + character(len=PIO_TF_MAX_STR_LEN), target :: fname = "pio_rearrs_combs.nc" ! pio_rearr.F90.in:188 + character(len=PIO_TF_MAX_STR_LEN), parameter :: attname = "filename" ! pio_rearr.F90.in:189 + character(len=PIO_TF_MAX_STR_LEN), parameter :: dimname = "filename_dim" ! pio_rearr.F90.in:190 + integer, parameter :: NUM_REARRANGERS = 2 ! pio_rearr.F90.in:191 + integer :: rearrs(NUM_REARRANGERS) = (/pio_rearr_subset,pio_rearr_box/) ! pio_rearr.F90.in:192 + integer, parameter :: MAX_PERMS = 4 ! pio_rearr.F90.in:193 + integer :: rearrs_perms(NUM_REARRANGERS,MAX_PERMS) = reshape(& + (/pio_rearr_subset, pio_rearr_box,& + pio_rearr_box, pio_rearr_subset,& + pio_rearr_subset, pio_rearr_subset,& + pio_rearr_box, pio_rearr_box/),& + (/NUM_REARRANGERS,MAX_PERMS/)& + ) ! pio_rearr.F90.in:200 + character(len=PIO_TF_MAX_STR_LEN) :: rearrs_perms_info(NUM_REARRANGERS,MAX_PERMS) =& + reshape(& + (/"PIO_REARR_SUBSET", "PIO_REARR_BOX ",& + "PIO_REARR_BOX ", "PIO_REARR_SUBSET",& + "PIO_REARR_SUBSET", "PIO_REARR_SUBSET",& + "PIO_REARR_BOX ", "PIO_REARR_BOX "/),& + (/NUM_REARRANGERS,MAX_PERMS/)& + ) ! pio_rearr.F90.in:208 + character(len=PIO_TF_MAX_STR_LEN) :: rearrs_info(NUM_REARRANGERS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) ! pio_rearr.F90.in:209 + integer, dimension(:), allocatable :: iotypes ! pio_rearr.F90.in:210 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_rearr.F90.in:211 + integer :: i, j, k, num_iotypes = 0 ! pio_rearr.F90.in:212 + type(file_desc_t) :: pio_file ! pio_rearr.F90.in:213 + + + type(iosystem_desc_t) :: dup_iosys ! pio_rearr.F90.in:215 + integer :: dup_comm ! pio_rearr.F90.in:216 + integer :: ret ! pio_rearr.F90.in:217 + + + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_rearr.F90.in:219 + do i=1,num_iotypes ! pio_rearr.F90.in:220 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing iotype: ", iotype_descs(i) + END IF + END IF ! pio_rearr.F90.in:221 + call create_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), & + fname, attname, dimname, ret) ! pio_rearr.F90.in:223 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + call MPI_COMM_RANK( pio_tf_comm_, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to create file :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:224)" + END IF + RETURN + END IF ! pio_rearr.F90.in:224 + + + call MPI_Comm_dup(pio_tf_comm_, dup_comm, ret) ! pio_rearr.F90.in:226 + ! Try different combinations of rearrangers + do k=1,MAX_PERMS ! pio_rearr.F90.in:228 + do j=1, NUM_REARRANGERS ! pio_rearr.F90.in:229 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing rearr : ", rearrs_perms_info(j,k) + END IF + END IF ! pio_rearr.F90.in:230 + call PIO_init(pio_tf_world_rank_, dup_comm, pio_tf_world_sz_, & + 1, &! Num aggregators + 1, &! Stride + rearrs_perms(j,k), dup_iosys, base=0) ! pio_rearr.F90.in:234 + call PIO_seterrorhandling(dup_iosys, PIO_BCAST_ERROR) ! pio_rearr.F90.in:235 + + + call open_and_check_rdwr(dup_comm, dup_iosys, iotypes(i), & + pio_file, fname, ret) ! pio_rearr.F90.in:238 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, dup_comm))) THEN + call MPI_COMM_RANK( dup_comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Checking rd+wr on file failed :" // fname,& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr.F90.in:239)" + END IF + RETURN + END IF ! pio_rearr.F90.in:239 + + + call PIO_finalize(dup_iosys, ret) ! pio_rearr.F90.in:241 + end do ! pio_rearr.F90.in:242 + end do ! pio_rearr.F90.in:243 + call PIO_deletefile(pio_tf_iosystem_, fname) ! pio_rearr.F90.in:244 + call MPI_Comm_free(dup_comm, ret) ! pio_rearr.F90.in:245 + end do ! pio_rearr.F90.in:246 + if(allocated(iotypes)) then ! pio_rearr.F90.in:247 + deallocate(iotypes) ! pio_rearr.F90.in:248 + deallocate(iotype_descs) ! pio_rearr.F90.in:249 + end if ! pio_rearr.F90.in:250 +END SUBROUTINE test_rearrs_combs ! pio_rearr.F90.in:251 + + + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_rearrs_base" + END IF + CALL test_rearrs_base() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "test_rearrs_base","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "test_rearrs_base","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting test_rearrs_combs" + END IF + CALL test_rearrs_combs() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "test_rearrs_combs","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "test_rearrs_combs","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_rearr_opts.F90.in2 b/tests/general/pio_rearr_opts.F90.in2 new file mode 100644 index 00000000000..276326f4c6b --- /dev/null +++ b/tests/general/pio_rearr_opts.F90.in2 @@ -0,0 +1,940 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_rearr_opts.F90.in + +MODULE pio_rearr_opts_tgv ! pio_rearr_opts.F90.in:1 + use pio_tutil ! pio_rearr_opts.F90.in:2 + character(len=PIO_TF_MAX_STR_LEN), parameter ::tgv_fname ="pio_rearr_opts_test.nc" ! pio_rearr_opts.F90.in:3 + character(len=PIO_TF_MAX_STR_LEN), parameter ::tgv_var_name ="dummy_var" ! pio_rearr_opts.F90.in:4 + character(len=PIO_TF_MAX_STR_LEN), parameter ::tgv_dim_name ="dummy_dim" ! pio_rearr_opts.F90.in:5 +END MODULE pio_rearr_opts_tgv ! pio_rearr_opts.F90.in:6 + + +! Test init/finalize wiht a default set of rearranger options +SUBROUTINE init_fin_with_rearr_opts + USE pio_tutil + ! pio_rearr_opts.F90.in:9 + implicit none ! pio_rearr_opts.F90.in:10 + + + integer, parameter :: NUM_REARRANGERS = 2 ! pio_rearr_opts.F90.in:12 + integer :: rearrs(NUM_REARRANGERS) = (/pio_rearr_subset,pio_rearr_box/) ! pio_rearr_opts.F90.in:13 + character(len=PIO_TF_MAX_STR_LEN) :: rearrs_info(NUM_REARRANGERS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) ! pio_rearr_opts.F90.in:14 + type(pio_rearr_opt_t) :: pio_rearr_opts ! pio_rearr_opts.F90.in:15 + ! Dummy val for max pend req + integer, parameter :: MAX_PEND_REQ = 10 ! pio_rearr_opts.F90.in:17 + + + type(iosystem_desc_t) :: dup_iosys ! pio_rearr_opts.F90.in:19 + integer :: dup_comm ! pio_rearr_opts.F90.in:20 + integer :: i, ret ! pio_rearr_opts.F90.in:21 + + + call MPI_Comm_dup(pio_tf_comm_, dup_comm, ret) ! pio_rearr_opts.F90.in:23 + + + do i=1,NUM_REARRANGERS ! pio_rearr_opts.F90.in:25 + ! Some dummy values for rearranger options + pio_rearr_opts%comm_type = PIO_rearr_comm_p2p ! pio_rearr_opts.F90.in:27 + pio_rearr_opts%fcd = PIO_rearr_comm_fc_2d_enable ! pio_rearr_opts.F90.in:28 + + + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = PIO_REARR_COMM_UNLIMITED_PEND_REQ ! pio_rearr_opts.F90.in:30 + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = .true. ! pio_rearr_opts.F90.in:31 + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = .true. ! pio_rearr_opts.F90.in:32 + + + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = MAX_PEND_REQ ! pio_rearr_opts.F90.in:34 + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = .true. ! pio_rearr_opts.F90.in:35 + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = .true. ! pio_rearr_opts.F90.in:36 + + + call PIO_init(pio_tf_world_rank_, dup_comm, pio_tf_world_sz_, & + 1, &! Num aggregators + 1, &! Stride + rearrs(i), dup_iosys, base=0, rearr_opts=pio_rearr_opts) ! pio_rearr_opts.F90.in:41 + call PIO_seterrorhandling(dup_iosys, PIO_BCAST_ERROR) ! pio_rearr_opts.F90.in:42 + + + call PIO_finalize(dup_iosys, ret) ! pio_rearr_opts.F90.in:44 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Finalize failed",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:45)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:45 + end do ! pio_rearr_opts.F90.in:46 + + + call MPI_Comm_free(dup_comm, ret) ! pio_rearr_opts.F90.in:48 + + +END SUBROUTINE init_fin_with_rearr_opts ! pio_rearr_opts.F90.in:50 + + +SUBROUTINE print_rearr_opts(pio_rearr_opts, ret) ! pio_rearr_opts.F90.in:52 + use pio_tutil ! pio_rearr_opts.F90.in:53 + implicit none ! pio_rearr_opts.F90.in:54 + + + type(pio_rearr_opt_t), intent(in) :: pio_rearr_opts ! pio_rearr_opts.F90.in:56 + integer, intent(inout) :: ret ! pio_rearr_opts.F90.in:57 + + + ret = PIO_NOERR ! pio_rearr_opts.F90.in:59 + + + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "PIO rearranger options :" + END IF + END IF ! pio_rearr_opts.F90.in:61 + if(pio_rearr_opts%comm_type == PIO_rearr_comm_p2p) then ! pio_rearr_opts.F90.in:62 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comm_type = PIO_rearr_comm_p2p" + END IF + END IF ! pio_rearr_opts.F90.in:63 + else if(pio_rearr_opts%comm_type == PIO_rearr_comm_coll) then ! pio_rearr_opts.F90.in:64 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comm_type = PIO_rearr_comm_coll" + END IF + END IF ! pio_rearr_opts.F90.in:65 + else ! pio_rearr_opts.F90.in:66 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comm_type = INVALID" + END IF + END IF ! pio_rearr_opts.F90.in:67 + end if ! pio_rearr_opts.F90.in:68 + + + if(pio_rearr_opts%fcd == PIO_rearr_comm_fc_2d_enable) then ! pio_rearr_opts.F90.in:70 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = PIO_rearr_comm_fc_2d_enable" + END IF + END IF ! pio_rearr_opts.F90.in:71 + else if(pio_rearr_opts%fcd == PIO_rearr_comm_fc_1d_comp2io) then ! pio_rearr_opts.F90.in:72 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = PIO_rearr_comm_fc_1d_comp2io" + END IF + END IF ! pio_rearr_opts.F90.in:73 + else if(pio_rearr_opts%fcd == PIO_rearr_comm_fc_1d_io2comp) then ! pio_rearr_opts.F90.in:74 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = PIO_rearr_comm_fc_1d_io2comp" + END IF + END IF ! pio_rearr_opts.F90.in:75 + else if(pio_rearr_opts%fcd == PIO_rearr_comm_fc_2d_disable) then ! pio_rearr_opts.F90.in:76 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = PIO_rearr_comm_fc_2d_disable" + END IF + END IF ! pio_rearr_opts.F90.in:77 + else ! pio_rearr_opts.F90.in:78 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = INVALID" + END IF + END IF ! pio_rearr_opts.F90.in:79 + end if ! pio_rearr_opts.F90.in:80 + + + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io max_pend_req =", pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req + END IF + END IF ! pio_rearr_opts.F90.in:82 + if(pio_rearr_opts%comm_fc_opts_comp2io%enable_hs) then ! pio_rearr_opts.F90.in:83 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io enable_hs = TRUE" + END IF + END IF ! pio_rearr_opts.F90.in:84 + else ! pio_rearr_opts.F90.in:85 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io enable_hs = FALSE" + END IF + END IF ! pio_rearr_opts.F90.in:86 + end if ! pio_rearr_opts.F90.in:87 + if(pio_rearr_opts%comm_fc_opts_comp2io%enable_isend) then ! pio_rearr_opts.F90.in:88 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io enable_isend = TRUE" + END IF + END IF ! pio_rearr_opts.F90.in:89 + else ! pio_rearr_opts.F90.in:90 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io enable_isend = FALSE" + END IF + END IF ! pio_rearr_opts.F90.in:91 + end if ! pio_rearr_opts.F90.in:92 + + + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp max_pend_req =", pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req + END IF + END IF ! pio_rearr_opts.F90.in:94 + if(pio_rearr_opts%comm_fc_opts_io2comp%enable_hs) then ! pio_rearr_opts.F90.in:95 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp enable_hs = TRUE" + END IF + END IF ! pio_rearr_opts.F90.in:96 + else ! pio_rearr_opts.F90.in:97 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp enable_hs = FALSE" + END IF + END IF ! pio_rearr_opts.F90.in:98 + end if ! pio_rearr_opts.F90.in:99 + if(pio_rearr_opts%comm_fc_opts_io2comp%enable_isend) then ! pio_rearr_opts.F90.in:100 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp enable_isend = TRUE" + END IF + END IF ! pio_rearr_opts.F90.in:101 + else ! pio_rearr_opts.F90.in:102 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp enable_isend = FALSE" + END IF + END IF ! pio_rearr_opts.F90.in:103 + end if ! pio_rearr_opts.F90.in:104 + + +END SUBROUTINE print_rearr_opts ! pio_rearr_opts.F90.in:106 + + +! If force_rearrange is FALSE, the decomposition is such that +! # All even procs have VEC_LOCAL_SZ elements +! # All odd procs have VEC_LOCAL_SZ + 1 elements +! e.g. For VEC_LOCAL_SZ = 2, +! e.g. 1) [1,2] [3,4,5] [6,7] +! e.g. 2) [1,2] [3,4,5] [6,7] [8,9,10] +! e.g. 3) [1,2] [3,4,5] [6,7] [8,9,10] [11,12] +! If force_rearrange is TRUE, the decomposition is such that, +! If possible, the even rank "exchanges" elements with the next +! higher ranked odd proc. +! This for example can be used to force rearrangement when reading +! or writing data. +! e.g. For VEC_LOCAL_SZ = 2, +! e.g. 1) [3,4,5] [1,2] [6,7] +! e.g. 2) [3,4,5] [1,2] [8,9,10] [6,7] +! e.g. 3) [3,4,5] [1,2] [8,9,10] [6,7] [11,12] +SUBROUTINE get_1d_bc_info(rank, sz, dims, start, count, force_rearrange) ! pio_rearr_opts.F90.in:124 + implicit none ! pio_rearr_opts.F90.in:125 + + + integer, parameter :: VEC_LOCAL_SZ = 3 ! pio_rearr_opts.F90.in:127 + integer, intent(in) :: rank ! pio_rearr_opts.F90.in:128 + integer, intent(in) :: sz ! pio_rearr_opts.F90.in:129 + integer, dimension(1), intent(out) :: dims ! pio_rearr_opts.F90.in:130 + integer, dimension(1), intent(out) :: start ! pio_rearr_opts.F90.in:131 + integer, dimension(1), intent(out) :: count ! pio_rearr_opts.F90.in:132 + logical, intent(in) :: force_rearrange ! pio_rearr_opts.F90.in:133 + + + logical :: is_even_rank ! pio_rearr_opts.F90.in:135 + integer :: num_odd_procs, num_even_procs ! pio_rearr_opts.F90.in:136 + integer :: iodd, ieven ! pio_rearr_opts.F90.in:137 + + + is_even_rank = .false. ! pio_rearr_opts.F90.in:139 + if (mod(rank, 2) == 0) then ! pio_rearr_opts.F90.in:140 + is_even_rank = .true. ! pio_rearr_opts.F90.in:141 + end if ! pio_rearr_opts.F90.in:142 + num_odd_procs = sz / 2 ! pio_rearr_opts.F90.in:143 + num_even_procs = sz - num_odd_procs ! pio_rearr_opts.F90.in:144 + dims(1) = num_even_procs * VEC_LOCAL_SZ + num_odd_procs * (VEC_LOCAL_SZ + 1) ! pio_rearr_opts.F90.in:145 + ! Number of odd and even procs before this rank + iodd = rank / 2 ! pio_rearr_opts.F90.in:147 + ieven = (rank + 1) / 2 ! pio_rearr_opts.F90.in:148 + if(force_rearrange) then ! pio_rearr_opts.F90.in:149 + ! Make sure that we force rearrangement + if (is_even_rank) then ! pio_rearr_opts.F90.in:151 + if(rank + 1 < sz) then ! pio_rearr_opts.F90.in:152 + ! Force rearrangement + count(1) = VEC_LOCAL_SZ + 1 ! pio_rearr_opts.F90.in:154 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + (VEC_LOCAL_SZ) + 1 ! pio_rearr_opts.F90.in:155 + else ! pio_rearr_opts.F90.in:156 + count(1) = VEC_LOCAL_SZ ! pio_rearr_opts.F90.in:157 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + 1 ! pio_rearr_opts.F90.in:158 + end if ! pio_rearr_opts.F90.in:159 + else ! pio_rearr_opts.F90.in:160 + ! For all odd procs there is an even lower ranked, rank-1, proc + ! So force rearrangement + count(1) = VEC_LOCAL_SZ ! pio_rearr_opts.F90.in:163 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) - (VEC_LOCAL_SZ) + 1 ! pio_rearr_opts.F90.in:164 + end if ! pio_rearr_opts.F90.in:165 + else ! pio_rearr_opts.F90.in:166 + if (is_even_rank) then ! pio_rearr_opts.F90.in:167 + count(1) = VEC_LOCAL_SZ ! pio_rearr_opts.F90.in:168 + else ! pio_rearr_opts.F90.in:169 + count(1) = VEC_LOCAL_SZ + 1 ! pio_rearr_opts.F90.in:170 + end if ! pio_rearr_opts.F90.in:171 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + 1 ! pio_rearr_opts.F90.in:172 + end if ! pio_rearr_opts.F90.in:173 + + +END SUBROUTINE ! pio_rearr_opts.F90.in:175 + + +! Create a decomp that will be used by tests below +! The iodesc needs to be freed by the caller +SUBROUTINE create_decomp_and_init_buf(iosys, iocomm, iodesc, wbuf, dims, ret) ! pio_rearr_opts.F90.in:179 + use pio_tutil ! pio_rearr_opts.F90.in:180 + implicit none ! pio_rearr_opts.F90.in:181 + + + type(iosystem_desc_t), intent(inout) :: iosys ! pio_rearr_opts.F90.in:183 + integer, intent(in) :: iocomm ! pio_rearr_opts.F90.in:184 + type(io_desc_t), intent(out) :: iodesc ! pio_rearr_opts.F90.in:185 + real, dimension(:), allocatable, intent(inout) :: wbuf ! pio_rearr_opts.F90.in:186 + integer, dimension(1), intent(out) :: dims ! pio_rearr_opts.F90.in:187 + integer, intent(out) :: ret ! pio_rearr_opts.F90.in:188 + + + integer :: pio_dim ! pio_rearr_opts.F90.in:190 + integer, dimension(:), allocatable :: compdof ! pio_rearr_opts.F90.in:191 + integer, dimension(1) :: start, count ! pio_rearr_opts.F90.in:192 + integer :: i ! pio_rearr_opts.F90.in:193 + integer :: rank, sz ! pio_rearr_opts.F90.in:194 + + + ret = PIO_NOERR ! pio_rearr_opts.F90.in:196 + + + call MPI_Comm_size(iocomm, sz, ret) ! pio_rearr_opts.F90.in:198 + call MPI_Comm_rank(iocomm, rank, ret) ! pio_rearr_opts.F90.in:199 + + + call get_1d_bc_info(rank, sz, dims, start, count, .true.) ! pio_rearr_opts.F90.in:201 + allocate(wbuf(count(1))) ! pio_rearr_opts.F90.in:202 + allocate(compdof(count(1))) ! pio_rearr_opts.F90.in:203 + do i=1,count(1) ! pio_rearr_opts.F90.in:204 + wbuf(i) = start(1) + i - 1 ! pio_rearr_opts.F90.in:205 + compdof(i) = wbuf(i) ! pio_rearr_opts.F90.in:206 + end do ! pio_rearr_opts.F90.in:207 + + + call PIO_initdecomp(iosys, PIO_real, dims, compdof, iodesc) ! pio_rearr_opts.F90.in:209 + deallocate(compdof) ! pio_rearr_opts.F90.in:210 + + +END SUBROUTINE ! pio_rearr_opts.F90.in:212 + + +! Create file and var used in the tests below +! All details are picked from pio_rearr_opts_tgv module +SUBROUTINE create_file_and_var(iotype, ret) ! pio_rearr_opts.F90.in:216 + use pio_tutil ! pio_rearr_opts.F90.in:217 + use pio_rearr_opts_tgv ! pio_rearr_opts.F90.in:218 + implicit none ! pio_rearr_opts.F90.in:219 + + + integer, intent(in) :: iotype ! pio_rearr_opts.F90.in:221 + integer, intent(out) :: ret ! pio_rearr_opts.F90.in:222 + + + type(file_desc_t) :: pio_file ! pio_rearr_opts.F90.in:224 + type(var_desc_t) :: pio_var ! pio_rearr_opts.F90.in:225 + integer :: pio_dim ! pio_rearr_opts.F90.in:226 + integer, dimension(1) :: dims ! pio_rearr_opts.F90.in:227 + integer, dimension(1) :: start, count ! pio_rearr_opts.F90.in:228 + + + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) ! pio_rearr_opts.F90.in:230 + + + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotype, tgv_fname, PIO_CLOBBER) ! pio_rearr_opts.F90.in:232 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:233)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:233 + + + ret = PIO_def_dim(pio_file, tgv_dim_name, dims(1), pio_dim) ! pio_rearr_opts.F90.in:235 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim file =" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:236)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:236 + + + ret = PIO_def_var(pio_file, tgv_var_name, pio_real, (/pio_dim/), pio_var) ! pio_rearr_opts.F90.in:238 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var file =" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:239)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:239 + + + ret = PIO_enddef(pio_file) ! pio_rearr_opts.F90.in:241 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef file =" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:242)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:242 + + + call PIO_closefile(pio_file) ! pio_rearr_opts.F90.in:244 + + +END SUBROUTINE ! pio_rearr_opts.F90.in:246 + + +! Open file and inq var +! All details are picked from pio_rearr_opts_tgv module +! Note: The file is kept open so the called needs to close it +SUBROUTINE open_file_and_get_var(iosys, pio_file, iotype, pio_var, dims, ret) ! pio_rearr_opts.F90.in:251 + use pio_tutil ! pio_rearr_opts.F90.in:252 + use pio_rearr_opts_tgv ! pio_rearr_opts.F90.in:253 + implicit none ! pio_rearr_opts.F90.in:254 + + + type(iosystem_desc_t), intent(inout) :: iosys ! pio_rearr_opts.F90.in:256 + type(file_desc_t), intent(out) :: pio_file ! pio_rearr_opts.F90.in:257 + integer, intent(in) :: iotype ! pio_rearr_opts.F90.in:258 + type(var_desc_t), intent(out) :: pio_var ! pio_rearr_opts.F90.in:259 + integer, dimension(1), intent(in) :: dims ! pio_rearr_opts.F90.in:260 + integer, intent(out) :: ret ! pio_rearr_opts.F90.in:261 + + + integer :: pio_dim ! pio_rearr_opts.F90.in:263 + + + ret = PIO_openfile(iosys, pio_file, iotype, tgv_fname, pio_write) ! pio_rearr_opts.F90.in:265 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:266)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:266 + + + ret = PIO_inq_varid(pio_file, tgv_var_name, pio_var) ! pio_rearr_opts.F90.in:268 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not inq var " // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:269)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:269 + + +END SUBROUTINE ! pio_rearr_opts.F90.in:271 + + + + +! Test all possible combinations of rearranger options +SUBROUTINE write_with_rearr_opts + USE pio_tutil + ! pio_rearr_opts.F90.in:275 + use pio_rearr_opts_tgv ! pio_rearr_opts.F90.in:276 + implicit none ! pio_rearr_opts.F90.in:277 + interface ! pio_rearr_opts.F90.in:278 + subroutine create_decomp_and_init_buf(iosys, iocomm, iodesc, wbuf, dims, ret) ! pio_rearr_opts.F90.in:279 + use pio_tutil ! pio_rearr_opts.F90.in:280 + type(iosystem_desc_t), intent(inout) :: iosys ! pio_rearr_opts.F90.in:281 + integer, intent(in) :: iocomm ! pio_rearr_opts.F90.in:282 + type(io_desc_t), intent(out) :: iodesc ! pio_rearr_opts.F90.in:283 + real, dimension(:), allocatable, intent(inout) :: wbuf ! pio_rearr_opts.F90.in:284 + integer, dimension(1), intent(out) :: dims ! pio_rearr_opts.F90.in:285 + integer, intent(out) :: ret ! pio_rearr_opts.F90.in:286 + end subroutine create_decomp_and_init_buf ! pio_rearr_opts.F90.in:287 + end interface ! pio_rearr_opts.F90.in:288 + + + integer, parameter :: NUM_REARRANGERS = 2 ! pio_rearr_opts.F90.in:290 + integer :: rearrs(NUM_REARRANGERS) = (/pio_rearr_subset,pio_rearr_box/) ! pio_rearr_opts.F90.in:291 + character(len=PIO_TF_MAX_STR_LEN) :: rearrs_info(NUM_REARRANGERS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) ! pio_rearr_opts.F90.in:292 + type(pio_rearr_opt_t) :: pio_rearr_opts ! pio_rearr_opts.F90.in:293 + + + ! Different rearranger options that are tested here + integer, parameter :: NUM_COMM_TYPE_OPTS = 2 ! pio_rearr_opts.F90.in:296 + integer :: comm_type_opts(NUM_COMM_TYPE_OPTS) =& + (/pio_rearr_comm_p2p,pio_rearr_comm_coll/) ! pio_rearr_opts.F90.in:298 + integer, parameter :: NUM_FCD_OPTS = 4 ! pio_rearr_opts.F90.in:299 + integer :: fcd_opts(NUM_FCD_OPTS) = & + (/pio_rearr_comm_fc_2d_disable,& + pio_rearr_comm_fc_1d_comp2io,& + pio_rearr_comm_fc_1d_io2comp,& + pio_rearr_comm_fc_2d_enable/) ! pio_rearr_opts.F90.in:304 + integer :: num_fcd_opts_comm_type ! pio_rearr_opts.F90.in:305 + integer, parameter :: NUM_ENABLE_HS_OPTS = 2 ! pio_rearr_opts.F90.in:306 + logical :: enable_hs_opts(NUM_ENABLE_HS_OPTS) = (/.true.,.false./) ! pio_rearr_opts.F90.in:307 + integer :: num_enable_hs_opts_comp2io, num_enable_hs_opts_io2comp ! pio_rearr_opts.F90.in:308 + integer, parameter :: NUM_ENABLE_ISEND_OPTS = 2 ! pio_rearr_opts.F90.in:309 + logical :: enable_isend_opts(NUM_ENABLE_ISEND_OPTS) = (/.true.,.false./) ! pio_rearr_opts.F90.in:310 + integer :: num_enable_isend_opts_comp2io, num_enable_isend_opts_io2comp ! pio_rearr_opts.F90.in:311 + integer, parameter :: NUM_MAX_PEND_REQ_OPTS = 2 ! pio_rearr_opts.F90.in:312 + integer :: max_pend_req_opts(NUM_MAX_PEND_REQ_OPTS) = & + (/pio_rearr_comm_unlimited_pend_req, 2/) ! pio_rearr_opts.F90.in:314 + integer :: num_max_pend_req_opts_comp2io, num_max_pend_req_opts_io2comp ! pio_rearr_opts.F90.in:315 + + + type(iosystem_desc_t) :: dup_iosys ! pio_rearr_opts.F90.in:317 + integer :: dup_comm ! pio_rearr_opts.F90.in:318 + integer :: cur_rearr, cur_comm_type_opt, cur_fcd_opt, cur_enable_hs_c2i, & + cur_enable_isend_c2i, cur_max_pend_req_c2i, & + cur_enable_hs_i2c, cur_enable_isend_i2c, cur_max_pend_req_i2c ! pio_rearr_opts.F90.in:321 + + + type(file_desc_t) :: pio_file ! pio_rearr_opts.F90.in:323 + type(io_desc_t) :: iodesc ! pio_rearr_opts.F90.in:324 + type(var_desc_t) :: pio_var ! pio_rearr_opts.F90.in:325 + integer, dimension(1) :: dims ! pio_rearr_opts.F90.in:326 + + + real, dimension(:), allocatable :: rbuf, wbuf ! pio_rearr_opts.F90.in:328 + + + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes ! pio_rearr_opts.F90.in:331 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_rearr_opts.F90.in:332 + integer :: num_iotypes ! pio_rearr_opts.F90.in:333 + integer :: ret, ierr, i ! pio_rearr_opts.F90.in:334 + + + num_iotypes = 0 ! pio_rearr_opts.F90.in:336 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_rearr_opts.F90.in:337 + do i=1,num_iotypes ! pio_rearr_opts.F90.in:338 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : ", iotype_descs(i) + END IF + END IF ! pio_rearr_opts.F90.in:339 + ! Create the file and decomp + call create_file_and_var(iotypes(i), ret) ! pio_rearr_opts.F90.in:341 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Creating file/decomp/var reqd for test failed :" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:342)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:342 + + + call MPI_Comm_dup(pio_tf_comm_, dup_comm, ret) ! pio_rearr_opts.F90.in:344 + + + ! Test all combinations of these flow control parameters + do cur_rearr=1,NUM_REARRANGERS ! pio_rearr_opts.F90.in:347 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing ", rearrs_info(cur_rearr) + END IF + END IF ! pio_rearr_opts.F90.in:348 + do cur_comm_type_opt=1,NUM_COMM_TYPE_OPTS ! pio_rearr_opts.F90.in:349 + pio_rearr_opts%comm_type = comm_type_opts(cur_comm_type_opt) ! pio_rearr_opts.F90.in:350 + if(pio_rearr_opts%comm_type == pio_rearr_comm_coll) then ! pio_rearr_opts.F90.in:351 + ! For coll we only test pio_rearr_comm_fc_2d_disable + num_fcd_opts_comm_type = 1 ! pio_rearr_opts.F90.in:353 + else if(pio_rearr_opts%comm_type == pio_rearr_comm_p2p) then ! pio_rearr_opts.F90.in:354 + ! for p2p we test all possible combinations + num_fcd_opts_comm_type = NUM_FCD_OPTS ! pio_rearr_opts.F90.in:356 + else ! pio_rearr_opts.F90.in:357 + + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Fatal Error:",& + "Unexpected comm type",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:358)" + END IF + RETURN ! pio_rearr_opts.F90.in:358 + end if ! pio_rearr_opts.F90.in:359 + do cur_fcd_opt=1,num_fcd_opts_comm_type ! pio_rearr_opts.F90.in:360 + pio_rearr_opts%fcd = fcd_opts(cur_fcd_opt) ! pio_rearr_opts.F90.in:361 + if(pio_rearr_opts%fcd == pio_rearr_comm_fc_2d_enable) then ! pio_rearr_opts.F90.in:362 + num_enable_hs_opts_comp2io = NUM_ENABLE_HS_OPTS ! pio_rearr_opts.F90.in:363 + num_enable_hs_opts_io2comp = NUM_ENABLE_HS_OPTS ! pio_rearr_opts.F90.in:364 + num_enable_isend_opts_comp2io = NUM_ENABLE_ISEND_OPTS ! pio_rearr_opts.F90.in:365 + num_enable_isend_opts_io2comp = NUM_ENABLE_ISEND_OPTS ! pio_rearr_opts.F90.in:366 + num_max_pend_req_opts_comp2io = NUM_MAX_PEND_REQ_OPTS ! pio_rearr_opts.F90.in:367 + num_max_pend_req_opts_io2comp = NUM_MAX_PEND_REQ_OPTS ! pio_rearr_opts.F90.in:368 + else if(pio_rearr_opts%fcd == pio_rearr_comm_fc_1d_comp2io) then ! pio_rearr_opts.F90.in:369 + ! Only test different rearr opts in comp2io direction + num_enable_hs_opts_comp2io = NUM_ENABLE_HS_OPTS ! pio_rearr_opts.F90.in:371 + num_enable_hs_opts_io2comp = 1 ! pio_rearr_opts.F90.in:372 + num_enable_isend_opts_comp2io = NUM_ENABLE_ISEND_OPTS ! pio_rearr_opts.F90.in:373 + num_enable_isend_opts_io2comp = 1 ! pio_rearr_opts.F90.in:374 + num_max_pend_req_opts_comp2io = NUM_MAX_PEND_REQ_OPTS ! pio_rearr_opts.F90.in:375 + num_max_pend_req_opts_io2comp = 1 ! pio_rearr_opts.F90.in:376 + else if(pio_rearr_opts%fcd == pio_rearr_comm_fc_1d_io2comp) then ! pio_rearr_opts.F90.in:377 + ! Only test different rearr opts in io2comp direction + num_enable_hs_opts_comp2io = 1 ! pio_rearr_opts.F90.in:379 + num_enable_hs_opts_io2comp = NUM_ENABLE_HS_OPTS ! pio_rearr_opts.F90.in:380 + num_enable_isend_opts_comp2io = 1 ! pio_rearr_opts.F90.in:381 + num_enable_isend_opts_io2comp = NUM_ENABLE_ISEND_OPTS ! pio_rearr_opts.F90.in:382 + num_max_pend_req_opts_comp2io = 1 ! pio_rearr_opts.F90.in:383 + num_max_pend_req_opts_io2comp = NUM_MAX_PEND_REQ_OPTS ! pio_rearr_opts.F90.in:384 + else if(pio_rearr_opts%fcd == pio_rearr_comm_fc_2d_disable) then ! pio_rearr_opts.F90.in:385 + ! Just test one default combination + num_enable_hs_opts_comp2io = 1 ! pio_rearr_opts.F90.in:387 + num_enable_hs_opts_io2comp = 1 ! pio_rearr_opts.F90.in:388 + num_enable_isend_opts_comp2io = 1 ! pio_rearr_opts.F90.in:389 + num_enable_isend_opts_io2comp = 1 ! pio_rearr_opts.F90.in:390 + num_max_pend_req_opts_comp2io = 1 ! pio_rearr_opts.F90.in:391 + num_max_pend_req_opts_io2comp = 1 ! pio_rearr_opts.F90.in:392 + else ! pio_rearr_opts.F90.in:393 + + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Fatal Error:",& + "Unexpected flow control option",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:394)" + END IF + RETURN ! pio_rearr_opts.F90.in:394 + end if ! pio_rearr_opts.F90.in:395 + do cur_enable_hs_c2i=1,num_enable_hs_opts_comp2io ! pio_rearr_opts.F90.in:396 + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = & + enable_hs_opts(cur_enable_hs_c2i) ! pio_rearr_opts.F90.in:398 + + + do cur_enable_isend_c2i=1,num_enable_isend_opts_comp2io ! pio_rearr_opts.F90.in:400 + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = & + enable_isend_opts(cur_enable_isend_c2i) ! pio_rearr_opts.F90.in:402 + + + do cur_max_pend_req_c2i=1,num_max_pend_req_opts_comp2io ! pio_rearr_opts.F90.in:404 + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = & + max_pend_req_opts(cur_max_pend_req_c2i) ! pio_rearr_opts.F90.in:406 + + + do cur_enable_hs_i2c=1,num_enable_hs_opts_io2comp ! pio_rearr_opts.F90.in:408 + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs =& + enable_hs_opts(cur_enable_hs_i2c) ! pio_rearr_opts.F90.in:410 + + + do cur_enable_isend_i2c=1,num_enable_isend_opts_io2comp ! pio_rearr_opts.F90.in:412 + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend =& + enable_isend_opts(cur_enable_isend_i2c) ! pio_rearr_opts.F90.in:414 + + + do cur_max_pend_req_i2c=1,num_max_pend_req_opts_io2comp ! pio_rearr_opts.F90.in:416 + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req =& + max_pend_req_opts(cur_max_pend_req_i2c) ! pio_rearr_opts.F90.in:418 + + + call print_rearr_opts(pio_rearr_opts, ret) ! pio_rearr_opts.F90.in:420 + ! Ignoring return value - just printing for info + call PIO_init(pio_tf_world_rank_,& + dup_comm, pio_tf_world_sz_, & + 1, &! Num aggregators + 1, &! Stride + rearrs(cur_rearr),& + dup_iosys, base=0,& + rearr_opts=pio_rearr_opts) ! pio_rearr_opts.F90.in:428 + + + call PIO_seterrorhandling(dup_iosys, PIO_BCAST_ERROR) ! pio_rearr_opts.F90.in:430 + + + call create_decomp_and_init_buf(dup_iosys, dup_comm, iodesc, wbuf, dims, ret) ! pio_rearr_opts.F90.in:432 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, dup_comm))) THEN + call MPI_COMM_RANK( dup_comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Creating decomp failed",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:433)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:433 + + + allocate(rbuf(size(wbuf))) ! pio_rearr_opts.F90.in:435 + rbuf = 0 ! pio_rearr_opts.F90.in:436 + + + call open_file_and_get_var(dup_iosys, pio_file, iotypes(i),& + pio_var, dims, ret) ! pio_rearr_opts.F90.in:439 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, dup_comm))) THEN + call MPI_COMM_RANK( dup_comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Creating file/decomp/var reqd for test failed :" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:440)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:440 + + + call PIO_write_darray(pio_file, pio_var, iodesc, wbuf, ret) ! pio_rearr_opts.F90.in:442 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, dup_comm))) THEN + call MPI_COMM_RANK( dup_comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Writing var failed fname="//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:443)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:443 + + + call PIO_syncfile(pio_file) ! pio_rearr_opts.F90.in:445 + + + call PIO_read_darray(pio_file, pio_var, iodesc, rbuf, ret) ! pio_rearr_opts.F90.in:447 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, dup_comm))) THEN + call MPI_COMM_RANK( dup_comm, pio_tf_tmp_comm_rank_, pio_tf_retval_utest_) + pio_tf_retval_utest_ = -1 + IF (pio_tf_tmp_comm_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Reading var failed fname="//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:448)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:448 + + + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:450)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:450 + + + call PIO_freedecomp(dup_iosys, iodesc) ! pio_rearr_opts.F90.in:452 + + + deallocate(rbuf) ! pio_rearr_opts.F90.in:454 + if(allocated(wbuf)) then ! pio_rearr_opts.F90.in:455 + deallocate(wbuf) ! pio_rearr_opts.F90.in:456 + end if ! pio_rearr_opts.F90.in:457 + + + call PIO_closefile(pio_file) ! pio_rearr_opts.F90.in:459 + + + call PIO_finalize(dup_iosys, ret) ! pio_rearr_opts.F90.in:461 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Finalize failed",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts.F90.in:462)" + END IF + RETURN + END IF ! pio_rearr_opts.F90.in:462 + end do ! cur_max_pend_req_i2c ! pio_rearr_opts.F90.in:463 + end do ! cur_enable_isend_i2c ! pio_rearr_opts.F90.in:464 + end do ! cur_enable_hs_i2c ! pio_rearr_opts.F90.in:465 + end do ! cur_max_pend_req_c2i ! pio_rearr_opts.F90.in:466 + end do ! cur_enable_isend_c2i ! pio_rearr_opts.F90.in:467 + end do ! cur_enable_hs_c2i ! pio_rearr_opts.F90.in:468 + end do ! cur_fcd_opt ! pio_rearr_opts.F90.in:469 + end do ! cur_comm_type_opt ! pio_rearr_opts.F90.in:470 + end do ! cur_rearr ! pio_rearr_opts.F90.in:471 + + + call PIO_deletefile(pio_tf_iosystem_, trim(tgv_fname)) ! pio_rearr_opts.F90.in:473 + + + call MPI_Comm_free(dup_comm, ret) ! pio_rearr_opts.F90.in:475 + end do ! iotypes ! pio_rearr_opts.F90.in:476 + + + if(allocated(iotypes)) then ! pio_rearr_opts.F90.in:478 + deallocate(iotypes) ! pio_rearr_opts.F90.in:479 + deallocate(iotype_descs) ! pio_rearr_opts.F90.in:480 + end if ! pio_rearr_opts.F90.in:481 + + +END SUBROUTINE write_with_rearr_opts ! pio_rearr_opts.F90.in:483 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting init_fin_with_rearr_opts" + END IF + CALL init_fin_with_rearr_opts() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "init_fin_with_rearr_opts","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "init_fin_with_rearr_opts","-----------", "FAILED" + END IF + END IF + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting write_with_rearr_opts" + END IF + CALL write_with_rearr_opts() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "write_with_rearr_opts","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 2:",& + "write_with_rearr_opts","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/pio_rearr_opts2.F90.in2 b/tests/general/pio_rearr_opts2.F90.in2 new file mode 100644 index 00000000000..4679ace5893 --- /dev/null +++ b/tests/general/pio_rearr_opts2.F90.in2 @@ -0,0 +1,822 @@ +! DON'T MODIFY THIS FILE, ALL YOUR CHANGES WILL BE LOST +! This file is generated by ../../../tests/general/util/pio_tf_f90gen.pl +! from /home/ed/tmp/ParallelIO/tests/general/pio_rearr_opts2.F90.in + +MODULE pio_rearr_opts_tgv ! pio_rearr_opts2.F90.in:1 + use pio_tutil ! pio_rearr_opts2.F90.in:2 + character(len=PIO_TF_MAX_STR_LEN), parameter ::tgv_fname ="pio_rearr_opts2_test.nc" ! pio_rearr_opts2.F90.in:3 + character(len=PIO_TF_MAX_STR_LEN), parameter ::tgv_var_name ="dummy_var" ! pio_rearr_opts2.F90.in:4 + character(len=PIO_TF_MAX_STR_LEN), parameter ::tgv_dim_name ="dummy_dim" ! pio_rearr_opts2.F90.in:5 +END MODULE pio_rearr_opts_tgv ! pio_rearr_opts2.F90.in:6 + + +SUBROUTINE print_rearr_opts(pio_rearr_opts, ret) ! pio_rearr_opts2.F90.in:8 + use pio_tutil ! pio_rearr_opts2.F90.in:9 + implicit none ! pio_rearr_opts2.F90.in:10 + + + type(pio_rearr_opt_t), intent(in) :: pio_rearr_opts ! pio_rearr_opts2.F90.in:12 + integer, intent(inout) :: ret ! pio_rearr_opts2.F90.in:13 + + + ret = PIO_NOERR ! pio_rearr_opts2.F90.in:15 + + + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "PIO rearranger options :" + END IF + END IF ! pio_rearr_opts2.F90.in:17 + if(pio_rearr_opts%comm_type == PIO_rearr_comm_p2p) then ! pio_rearr_opts2.F90.in:18 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comm_type = PIO_rearr_comm_p2p" + END IF + END IF ! pio_rearr_opts2.F90.in:19 + else if(pio_rearr_opts%comm_type == PIO_rearr_comm_coll) then ! pio_rearr_opts2.F90.in:20 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comm_type = PIO_rearr_comm_coll" + END IF + END IF ! pio_rearr_opts2.F90.in:21 + else ! pio_rearr_opts2.F90.in:22 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comm_type = INVALID" + END IF + END IF ! pio_rearr_opts2.F90.in:23 + end if ! pio_rearr_opts2.F90.in:24 + + + if(pio_rearr_opts%fcd == PIO_rearr_comm_fc_2d_enable) then ! pio_rearr_opts2.F90.in:26 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = PIO_rearr_comm_fc_2d_enable" + END IF + END IF ! pio_rearr_opts2.F90.in:27 + else if(pio_rearr_opts%fcd == PIO_rearr_comm_fc_1d_comp2io) then ! pio_rearr_opts2.F90.in:28 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = PIO_rearr_comm_fc_1d_comp2io" + END IF + END IF ! pio_rearr_opts2.F90.in:29 + else if(pio_rearr_opts%fcd == PIO_rearr_comm_fc_1d_io2comp) then ! pio_rearr_opts2.F90.in:30 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = PIO_rearr_comm_fc_1d_io2comp" + END IF + END IF ! pio_rearr_opts2.F90.in:31 + else if(pio_rearr_opts%fcd == PIO_rearr_comm_fc_2d_disable) then ! pio_rearr_opts2.F90.in:32 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = PIO_rearr_comm_fc_2d_disable" + END IF + END IF ! pio_rearr_opts2.F90.in:33 + else ! pio_rearr_opts2.F90.in:34 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " fcd = INVALID" + END IF + END IF ! pio_rearr_opts2.F90.in:35 + end if ! pio_rearr_opts2.F90.in:36 + + + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io max_pend_req =", pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req + END IF + END IF ! pio_rearr_opts2.F90.in:38 + if(pio_rearr_opts%comm_fc_opts_comp2io%enable_hs) then ! pio_rearr_opts2.F90.in:39 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io enable_hs = TRUE" + END IF + END IF ! pio_rearr_opts2.F90.in:40 + else ! pio_rearr_opts2.F90.in:41 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io enable_hs = FALSE" + END IF + END IF ! pio_rearr_opts2.F90.in:42 + end if ! pio_rearr_opts2.F90.in:43 + if(pio_rearr_opts%comm_fc_opts_comp2io%enable_isend) then ! pio_rearr_opts2.F90.in:44 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io enable_isend = TRUE" + END IF + END IF ! pio_rearr_opts2.F90.in:45 + else ! pio_rearr_opts2.F90.in:46 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " comp2io enable_isend = FALSE" + END IF + END IF ! pio_rearr_opts2.F90.in:47 + end if ! pio_rearr_opts2.F90.in:48 + + + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp max_pend_req =", pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req + END IF + END IF ! pio_rearr_opts2.F90.in:50 + if(pio_rearr_opts%comm_fc_opts_io2comp%enable_hs) then ! pio_rearr_opts2.F90.in:51 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp enable_hs = TRUE" + END IF + END IF ! pio_rearr_opts2.F90.in:52 + else ! pio_rearr_opts2.F90.in:53 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp enable_hs = FALSE" + END IF + END IF ! pio_rearr_opts2.F90.in:54 + end if ! pio_rearr_opts2.F90.in:55 + if(pio_rearr_opts%comm_fc_opts_io2comp%enable_isend) then ! pio_rearr_opts2.F90.in:56 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp enable_isend = TRUE" + END IF + END IF ! pio_rearr_opts2.F90.in:57 + else ! pio_rearr_opts2.F90.in:58 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) " io2comp enable_isend = FALSE" + END IF + END IF ! pio_rearr_opts2.F90.in:59 + end if ! pio_rearr_opts2.F90.in:60 + + +END SUBROUTINE print_rearr_opts ! pio_rearr_opts2.F90.in:62 + + +! If force_rearrange is FALSE, the decomposition is such that +! # All even procs have VEC_LOCAL_SZ elements +! # All odd procs have VEC_LOCAL_SZ + 1 elements +! e.g. For VEC_LOCAL_SZ = 2, +! e.g. 1) [1,2] [3,4,5] [6,7] +! e.g. 2) [1,2] [3,4,5] [6,7] [8,9,10] +! e.g. 3) [1,2] [3,4,5] [6,7] [8,9,10] [11,12] +! If force_rearrange is TRUE, the decomposition is such that, +! If possible, the even rank "exchanges" elements with the next +! higher ranked odd proc. +! This for example can be used to force rearrangement when reading +! or writing data. +! e.g. For VEC_LOCAL_SZ = 2, +! e.g. 1) [3,4,5] [1,2] [6,7] +! e.g. 2) [3,4,5] [1,2] [8,9,10] [6,7] +! e.g. 3) [3,4,5] [1,2] [8,9,10] [6,7] [11,12] +SUBROUTINE get_1d_bc_info(rank, sz, dims, start, count, force_rearrange) ! pio_rearr_opts2.F90.in:80 + implicit none ! pio_rearr_opts2.F90.in:81 + + + integer, parameter :: VEC_LOCAL_SZ = 3 ! pio_rearr_opts2.F90.in:83 + integer, intent(in) :: rank ! pio_rearr_opts2.F90.in:84 + integer, intent(in) :: sz ! pio_rearr_opts2.F90.in:85 + integer, dimension(1), intent(out) :: dims ! pio_rearr_opts2.F90.in:86 + integer, dimension(1), intent(out) :: start ! pio_rearr_opts2.F90.in:87 + integer, dimension(1), intent(out) :: count ! pio_rearr_opts2.F90.in:88 + logical, intent(in) :: force_rearrange ! pio_rearr_opts2.F90.in:89 + + + logical :: is_even_rank ! pio_rearr_opts2.F90.in:91 + integer :: num_odd_procs, num_even_procs ! pio_rearr_opts2.F90.in:92 + integer :: iodd, ieven ! pio_rearr_opts2.F90.in:93 + + + is_even_rank = .false. ! pio_rearr_opts2.F90.in:95 + if (mod(rank, 2) == 0) then ! pio_rearr_opts2.F90.in:96 + is_even_rank = .true. ! pio_rearr_opts2.F90.in:97 + end if ! pio_rearr_opts2.F90.in:98 + num_odd_procs = sz / 2 ! pio_rearr_opts2.F90.in:99 + num_even_procs = sz - num_odd_procs ! pio_rearr_opts2.F90.in:100 + dims(1) = num_even_procs * VEC_LOCAL_SZ + num_odd_procs * (VEC_LOCAL_SZ + 1) ! pio_rearr_opts2.F90.in:101 + ! Number of odd and even procs before this rank + iodd = rank / 2 ! pio_rearr_opts2.F90.in:103 + ieven = (rank + 1) / 2 ! pio_rearr_opts2.F90.in:104 + if(force_rearrange) then ! pio_rearr_opts2.F90.in:105 + ! Make sure that we force rearrangement + if (is_even_rank) then ! pio_rearr_opts2.F90.in:107 + if(rank + 1 < sz) then ! pio_rearr_opts2.F90.in:108 + ! Force rearrangement + count(1) = VEC_LOCAL_SZ + 1 ! pio_rearr_opts2.F90.in:110 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + (VEC_LOCAL_SZ) + 1 ! pio_rearr_opts2.F90.in:111 + else ! pio_rearr_opts2.F90.in:112 + count(1) = VEC_LOCAL_SZ ! pio_rearr_opts2.F90.in:113 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + 1 ! pio_rearr_opts2.F90.in:114 + end if ! pio_rearr_opts2.F90.in:115 + else ! pio_rearr_opts2.F90.in:116 + ! For all odd procs there is an even lower ranked, rank-1, proc + ! So force rearrangement + count(1) = VEC_LOCAL_SZ ! pio_rearr_opts2.F90.in:119 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) - (VEC_LOCAL_SZ) + 1 ! pio_rearr_opts2.F90.in:120 + end if ! pio_rearr_opts2.F90.in:121 + else ! pio_rearr_opts2.F90.in:122 + if (is_even_rank) then ! pio_rearr_opts2.F90.in:123 + count(1) = VEC_LOCAL_SZ ! pio_rearr_opts2.F90.in:124 + else ! pio_rearr_opts2.F90.in:125 + count(1) = VEC_LOCAL_SZ + 1 ! pio_rearr_opts2.F90.in:126 + end if ! pio_rearr_opts2.F90.in:127 + start(1) = ieven * VEC_LOCAL_SZ + iodd * (VEC_LOCAL_SZ + 1) + 1 ! pio_rearr_opts2.F90.in:128 + end if ! pio_rearr_opts2.F90.in:129 + + +END SUBROUTINE ! pio_rearr_opts2.F90.in:131 + + +! Create a decomp that will be used by tests below +! The iodesc needs to be freed by the caller +SUBROUTINE create_decomp_and_init_buf(iodesc, wbuf, dims, ret) ! pio_rearr_opts2.F90.in:135 + use pio_tutil ! pio_rearr_opts2.F90.in:136 + implicit none ! pio_rearr_opts2.F90.in:137 + + + type(io_desc_t), intent(out) :: iodesc ! pio_rearr_opts2.F90.in:139 + real, dimension(:), allocatable, intent(inout) :: wbuf ! pio_rearr_opts2.F90.in:140 + integer, dimension(1), intent(out) :: dims ! pio_rearr_opts2.F90.in:141 + integer, intent(out) :: ret ! pio_rearr_opts2.F90.in:142 + + + integer :: pio_dim ! pio_rearr_opts2.F90.in:144 + integer, dimension(:), allocatable :: compdof ! pio_rearr_opts2.F90.in:145 + integer, dimension(1) :: start, count ! pio_rearr_opts2.F90.in:146 + integer :: i ! pio_rearr_opts2.F90.in:147 + + + ret = PIO_NOERR ! pio_rearr_opts2.F90.in:149 + + + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) ! pio_rearr_opts2.F90.in:151 + allocate(wbuf(count(1))) ! pio_rearr_opts2.F90.in:152 + allocate(compdof(count(1))) ! pio_rearr_opts2.F90.in:153 + do i=1,count(1) ! pio_rearr_opts2.F90.in:154 + wbuf(i) = start(1) + i - 1 ! pio_rearr_opts2.F90.in:155 + compdof(i) = wbuf(i) ! pio_rearr_opts2.F90.in:156 + end do ! pio_rearr_opts2.F90.in:157 + + + call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, iodesc) ! pio_rearr_opts2.F90.in:159 + deallocate(compdof) ! pio_rearr_opts2.F90.in:160 + + +END SUBROUTINE ! pio_rearr_opts2.F90.in:162 + + +! Create file and var used in the tests below +! All details are picked from pio_rearr_opts_tgv module +SUBROUTINE create_file_and_var(iotype, ret) ! pio_rearr_opts2.F90.in:166 + use pio_tutil ! pio_rearr_opts2.F90.in:167 + use pio_rearr_opts_tgv ! pio_rearr_opts2.F90.in:168 + implicit none ! pio_rearr_opts2.F90.in:169 + + + integer, intent(in) :: iotype ! pio_rearr_opts2.F90.in:171 + integer, intent(out) :: ret ! pio_rearr_opts2.F90.in:172 + + + type(file_desc_t) :: pio_file ! pio_rearr_opts2.F90.in:174 + type(var_desc_t) :: pio_var ! pio_rearr_opts2.F90.in:175 + integer :: pio_dim ! pio_rearr_opts2.F90.in:176 + integer, dimension(1) :: dims ! pio_rearr_opts2.F90.in:177 + integer, dimension(1) :: start, count ! pio_rearr_opts2.F90.in:178 + + + call get_1d_bc_info(pio_tf_world_rank_, pio_tf_world_sz_, dims, start, count, .true.) ! pio_rearr_opts2.F90.in:180 + + + ret = PIO_createfile(pio_tf_iosystem_, pio_file, iotype, tgv_fname, PIO_CLOBBER) ! pio_rearr_opts2.F90.in:182 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:183)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:183 + + + ret = PIO_def_dim(pio_file, tgv_dim_name, dims(1), pio_dim) ! pio_rearr_opts2.F90.in:185 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define dim file =" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:186)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:186 + + + ret = PIO_def_var(pio_file, tgv_var_name, pio_real, (/pio_dim/), pio_var) ! pio_rearr_opts2.F90.in:188 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to define var file =" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:189)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:189 + + + ret = PIO_enddef(pio_file) ! pio_rearr_opts2.F90.in:191 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Failed to enddef file =" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:192)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:192 + + + call PIO_closefile(pio_file) ! pio_rearr_opts2.F90.in:194 + + +END SUBROUTINE ! pio_rearr_opts2.F90.in:196 + + +! Open file and inq var +! All details are picked from pio_rearr_opts_tgv module +! Note: The file is kept open so the called needs to close it +SUBROUTINE open_file_and_get_var(pio_file, iotype, pio_var, ret) ! pio_rearr_opts2.F90.in:201 + use pio_tutil ! pio_rearr_opts2.F90.in:202 + use pio_rearr_opts_tgv ! pio_rearr_opts2.F90.in:203 + implicit none ! pio_rearr_opts2.F90.in:204 + + + type(file_desc_t), intent(out) :: pio_file ! pio_rearr_opts2.F90.in:206 + integer, intent(in) :: iotype ! pio_rearr_opts2.F90.in:207 + type(var_desc_t), intent(out) :: pio_var ! pio_rearr_opts2.F90.in:208 + integer, intent(out) :: ret ! pio_rearr_opts2.F90.in:209 + + + integer :: pio_dim ! pio_rearr_opts2.F90.in:211 + + + ret = PIO_openfile(pio_tf_iosystem_, pio_file, iotype, tgv_fname, pio_write) ! pio_rearr_opts2.F90.in:213 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not create file " // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:214)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:214 + + + ret = PIO_inq_varid(pio_file, tgv_var_name, pio_var) ! pio_rearr_opts2.F90.in:216 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Could not inq var " // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:217)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:217 + + +END SUBROUTINE ! pio_rearr_opts2.F90.in:219 + + +! Test all possible combinations of rearranger options +! using the pio interface to explicitly set the rearranger options +! after init. +SUBROUTINE set_rearr_opts_and_write + USE pio_tutil + ! pio_rearr_opts2.F90.in:224 + use pio_rearr_opts_tgv ! pio_rearr_opts2.F90.in:225 + implicit none ! pio_rearr_opts2.F90.in:226 + interface ! pio_rearr_opts2.F90.in:227 + subroutine create_decomp_and_init_buf(iodesc, wbuf, dims, ret) ! pio_rearr_opts2.F90.in:228 + use pio_tutil ! pio_rearr_opts2.F90.in:229 + type(io_desc_t), intent(out) :: iodesc ! pio_rearr_opts2.F90.in:230 + real, dimension(:), allocatable, intent(inout) :: wbuf ! pio_rearr_opts2.F90.in:231 + integer, dimension(1), intent(out) :: dims ! pio_rearr_opts2.F90.in:232 + integer, intent(out) :: ret ! pio_rearr_opts2.F90.in:233 + end subroutine create_decomp_and_init_buf ! pio_rearr_opts2.F90.in:234 + end interface ! pio_rearr_opts2.F90.in:235 + + + type(pio_rearr_opt_t) :: pio_rearr_opts ! pio_rearr_opts2.F90.in:237 + + + ! Different rearranger options that are tested here + integer, parameter :: NUM_COMM_TYPE_OPTS = 2 ! pio_rearr_opts2.F90.in:240 + integer :: comm_type_opts(NUM_COMM_TYPE_OPTS) =& + (/pio_rearr_comm_p2p,pio_rearr_comm_coll/) ! pio_rearr_opts2.F90.in:242 + integer, parameter :: NUM_FCD_OPTS = 4 ! pio_rearr_opts2.F90.in:243 + integer :: fcd_opts(NUM_FCD_OPTS) = & + (/pio_rearr_comm_fc_2d_disable,& + pio_rearr_comm_fc_1d_comp2io,& + pio_rearr_comm_fc_1d_io2comp,& + pio_rearr_comm_fc_2d_enable/) ! pio_rearr_opts2.F90.in:248 + integer :: num_fcd_opts_comm_type ! pio_rearr_opts2.F90.in:249 + integer, parameter :: NUM_ENABLE_HS_OPTS = 2 ! pio_rearr_opts2.F90.in:250 + logical :: enable_hs_opts(NUM_ENABLE_HS_OPTS) = (/.true.,.false./) ! pio_rearr_opts2.F90.in:251 + integer :: num_enable_hs_opts_comp2io, num_enable_hs_opts_io2comp ! pio_rearr_opts2.F90.in:252 + integer, parameter :: NUM_ENABLE_ISEND_OPTS = 2 ! pio_rearr_opts2.F90.in:253 + logical :: enable_isend_opts(NUM_ENABLE_ISEND_OPTS) = (/.true.,.false./) ! pio_rearr_opts2.F90.in:254 + integer :: num_enable_isend_opts_comp2io, num_enable_isend_opts_io2comp ! pio_rearr_opts2.F90.in:255 + integer, parameter :: NUM_MAX_PEND_REQ_OPTS = 3 ! pio_rearr_opts2.F90.in:256 + integer :: max_pend_req_opts(NUM_MAX_PEND_REQ_OPTS) = & + (/pio_rearr_comm_unlimited_pend_req, 1, 2/) ! pio_rearr_opts2.F90.in:258 + integer :: num_max_pend_req_opts_comp2io, num_max_pend_req_opts_io2comp ! pio_rearr_opts2.F90.in:259 + + + integer :: cur_comm_type_opt, cur_fcd_opt, cur_enable_hs_c2i, & + cur_enable_isend_c2i, cur_max_pend_req_c2i, & + cur_enable_hs_i2c, cur_enable_isend_i2c, cur_max_pend_req_i2c ! pio_rearr_opts2.F90.in:263 + + + type(file_desc_t) :: pio_file ! pio_rearr_opts2.F90.in:265 + type(io_desc_t) :: iodesc ! pio_rearr_opts2.F90.in:266 + type(var_desc_t) :: pio_var ! pio_rearr_opts2.F90.in:267 + integer, dimension(1) :: dims ! pio_rearr_opts2.F90.in:268 + + + real, dimension(:), allocatable :: rbuf, wbuf ! pio_rearr_opts2.F90.in:270 + + + ! iotypes = valid io types + integer, dimension(:), allocatable :: iotypes ! pio_rearr_opts2.F90.in:273 + character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs ! pio_rearr_opts2.F90.in:274 + integer :: num_iotypes ! pio_rearr_opts2.F90.in:275 + integer :: ret, ierr, i ! pio_rearr_opts2.F90.in:276 + + + num_iotypes = 0 ! pio_rearr_opts2.F90.in:278 + call PIO_TF_Get_nc_iotypes(iotypes, iotype_descs, num_iotypes) ! pio_rearr_opts2.F90.in:279 + do i=1,num_iotypes ! pio_rearr_opts2.F90.in:280 + + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_log_level_ >= 0) THEN + WRITE(*,"(A)",ADVANCE="NO") "PIO_TF: " + WRITE(*,*) "Testing : ", iotype_descs(i) + END IF + END IF ! pio_rearr_opts2.F90.in:281 + ! Create the file and decomp + call create_file_and_var(iotypes(i), ret) ! pio_rearr_opts2.F90.in:283 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Creating file/decomp/var reqd for test failed :" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:284)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:284 + + + call open_file_and_get_var(pio_file, iotypes(i), pio_var, ret) ! pio_rearr_opts2.F90.in:286 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Creating file/decomp/var reqd for test failed :" // trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:287)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:287 + + + ! Test all combinations of these flow control parameters + do cur_comm_type_opt=1,NUM_COMM_TYPE_OPTS ! pio_rearr_opts2.F90.in:290 + pio_rearr_opts%comm_type = comm_type_opts(cur_comm_type_opt) ! pio_rearr_opts2.F90.in:291 + if(pio_rearr_opts%comm_type == pio_rearr_comm_coll) then ! pio_rearr_opts2.F90.in:292 + ! For coll we only test pio_rearr_comm_fc_2d_disable + num_fcd_opts_comm_type = 1 ! pio_rearr_opts2.F90.in:294 + else if(pio_rearr_opts%comm_type == pio_rearr_comm_p2p) then ! pio_rearr_opts2.F90.in:295 + ! for p2p we test all possible combinations + num_fcd_opts_comm_type = NUM_FCD_OPTS ! pio_rearr_opts2.F90.in:297 + else ! pio_rearr_opts2.F90.in:298 + + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Fatal Error:",& + "Unexpected comm type",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:299)" + END IF + RETURN ! pio_rearr_opts2.F90.in:299 + end if ! pio_rearr_opts2.F90.in:300 + do cur_fcd_opt=1,num_fcd_opts_comm_type ! pio_rearr_opts2.F90.in:301 + pio_rearr_opts%fcd = fcd_opts(cur_fcd_opt) ! pio_rearr_opts2.F90.in:302 + if(pio_rearr_opts%fcd == pio_rearr_comm_fc_2d_enable) then ! pio_rearr_opts2.F90.in:303 + num_enable_hs_opts_comp2io = NUM_ENABLE_HS_OPTS ! pio_rearr_opts2.F90.in:304 + num_enable_hs_opts_io2comp = NUM_ENABLE_HS_OPTS ! pio_rearr_opts2.F90.in:305 + num_enable_isend_opts_comp2io = NUM_ENABLE_ISEND_OPTS ! pio_rearr_opts2.F90.in:306 + num_enable_isend_opts_io2comp = NUM_ENABLE_ISEND_OPTS ! pio_rearr_opts2.F90.in:307 + num_max_pend_req_opts_comp2io = NUM_MAX_PEND_REQ_OPTS ! pio_rearr_opts2.F90.in:308 + num_max_pend_req_opts_io2comp = NUM_MAX_PEND_REQ_OPTS ! pio_rearr_opts2.F90.in:309 + else if(pio_rearr_opts%fcd == pio_rearr_comm_fc_1d_comp2io) then ! pio_rearr_opts2.F90.in:310 + ! Only test different rearr opts in comp2io direction + num_enable_hs_opts_comp2io = NUM_ENABLE_HS_OPTS ! pio_rearr_opts2.F90.in:312 + num_enable_hs_opts_io2comp = 1 ! pio_rearr_opts2.F90.in:313 + num_enable_isend_opts_comp2io = NUM_ENABLE_ISEND_OPTS ! pio_rearr_opts2.F90.in:314 + num_enable_isend_opts_io2comp = 1 ! pio_rearr_opts2.F90.in:315 + num_max_pend_req_opts_comp2io = NUM_MAX_PEND_REQ_OPTS ! pio_rearr_opts2.F90.in:316 + num_max_pend_req_opts_io2comp = 1 ! pio_rearr_opts2.F90.in:317 + else if(pio_rearr_opts%fcd == pio_rearr_comm_fc_1d_io2comp) then ! pio_rearr_opts2.F90.in:318 + ! Only test different rearr opts in io2comp direction + num_enable_hs_opts_comp2io = 1 ! pio_rearr_opts2.F90.in:320 + num_enable_hs_opts_io2comp = NUM_ENABLE_HS_OPTS ! pio_rearr_opts2.F90.in:321 + num_enable_isend_opts_comp2io = 1 ! pio_rearr_opts2.F90.in:322 + num_enable_isend_opts_io2comp = NUM_ENABLE_ISEND_OPTS ! pio_rearr_opts2.F90.in:323 + num_max_pend_req_opts_comp2io = 1 ! pio_rearr_opts2.F90.in:324 + num_max_pend_req_opts_io2comp = NUM_MAX_PEND_REQ_OPTS ! pio_rearr_opts2.F90.in:325 + else if(pio_rearr_opts%fcd == pio_rearr_comm_fc_2d_disable) then ! pio_rearr_opts2.F90.in:326 + ! Just test one default combination + num_enable_hs_opts_comp2io = 1 ! pio_rearr_opts2.F90.in:328 + num_enable_hs_opts_io2comp = 1 ! pio_rearr_opts2.F90.in:329 + num_enable_isend_opts_comp2io = 1 ! pio_rearr_opts2.F90.in:330 + num_enable_isend_opts_io2comp = 1 ! pio_rearr_opts2.F90.in:331 + num_max_pend_req_opts_comp2io = 1 ! pio_rearr_opts2.F90.in:332 + num_max_pend_req_opts_io2comp = 1 ! pio_rearr_opts2.F90.in:333 + else ! pio_rearr_opts2.F90.in:334 + + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Fatal Error:",& + "Unexpected flow control option",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:335)" + END IF + RETURN ! pio_rearr_opts2.F90.in:335 + end if ! pio_rearr_opts2.F90.in:336 + do cur_enable_hs_c2i=1,num_enable_hs_opts_comp2io ! pio_rearr_opts2.F90.in:337 + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = & + enable_hs_opts(cur_enable_hs_c2i) ! pio_rearr_opts2.F90.in:339 + + + do cur_enable_isend_c2i=1,num_enable_isend_opts_comp2io ! pio_rearr_opts2.F90.in:341 + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = & + enable_isend_opts(cur_enable_isend_c2i) ! pio_rearr_opts2.F90.in:343 + + + do cur_max_pend_req_c2i=1,num_max_pend_req_opts_comp2io ! pio_rearr_opts2.F90.in:345 + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = & + max_pend_req_opts(cur_max_pend_req_c2i) ! pio_rearr_opts2.F90.in:347 + + + do cur_enable_hs_i2c=1,num_enable_hs_opts_io2comp ! pio_rearr_opts2.F90.in:349 + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs =& + enable_hs_opts(cur_enable_hs_i2c) ! pio_rearr_opts2.F90.in:351 + + + do cur_enable_isend_i2c=1,num_enable_isend_opts_io2comp ! pio_rearr_opts2.F90.in:353 + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend =& + enable_isend_opts(cur_enable_isend_i2c) ! pio_rearr_opts2.F90.in:355 + + + do cur_max_pend_req_i2c=1,num_max_pend_req_opts_io2comp ! pio_rearr_opts2.F90.in:357 + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req =& + max_pend_req_opts(cur_max_pend_req_i2c) ! pio_rearr_opts2.F90.in:359 + + + call print_rearr_opts(pio_rearr_opts, ret) ! pio_rearr_opts2.F90.in:361 + ! Ignoring return value - just printing for info + + + ! Set the rearranger options + ! rearr_opt_t descributes logicals as logical(kind=c_bool) + ! but pio_set_rearr_opts() expects regular logicals, hence + ! explicit type cast is reqd for logical params + ret = PIO_set_rearr_opts(pio_tf_iosystem_,& + pio_rearr_opts%comm_type,& + pio_rearr_opts%fcd,& + logical(pio_rearr_opts%comm_fc_opts_comp2io%enable_hs),& + logical(pio_rearr_opts%comm_fc_opts_comp2io%enable_isend),& + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req,& + logical(pio_rearr_opts%comm_fc_opts_io2comp%enable_hs),& + logical(pio_rearr_opts%comm_fc_opts_io2comp%enable_isend),& + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req) ! pio_rearr_opts2.F90.in:376 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Setting rearr opts failed fname="//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:377)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:377 + + + call create_decomp_and_init_buf(iodesc, wbuf, dims, ret) ! pio_rearr_opts2.F90.in:379 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Creating decomp failed",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:380)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:380 + + + allocate(rbuf(size(wbuf))) ! pio_rearr_opts2.F90.in:382 + rbuf = 0 ! pio_rearr_opts2.F90.in:383 + + + call PIO_write_darray(pio_file, pio_var, iodesc, wbuf, ret) ! pio_rearr_opts2.F90.in:385 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Writing var failed fname="//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:386)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:386 + + + call PIO_syncfile(pio_file) ! pio_rearr_opts2.F90.in:388 + + + call PIO_read_darray(pio_file, pio_var, iodesc, rbuf, ret) ! pio_rearr_opts2.F90.in:390 + + IF (.NOT. (PIO_TF_Passert_((ret) == PIO_NOERR, pio_tf_comm_))) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Function failed:",& + "Reading var failed fname="//trim(tgv_fname),& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:391)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:391 + + + + IF (.NOT. PIO_TF_Check_val_(rbuf, wbuf)) THEN + pio_tf_retval_utest_ = -1 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: PIO Check failed:",& + "Got wrong val",& + ":", __FILE__, ":", __LINE__,& + "(pio_rearr_opts2.F90.in:393)" + END IF + RETURN + END IF ! pio_rearr_opts2.F90.in:393 + + + call PIO_freedecomp(pio_tf_iosystem_, iodesc) ! pio_rearr_opts2.F90.in:395 + + + deallocate(rbuf) ! pio_rearr_opts2.F90.in:397 + if(allocated(wbuf)) then ! pio_rearr_opts2.F90.in:398 + deallocate(wbuf) ! pio_rearr_opts2.F90.in:399 + end if ! pio_rearr_opts2.F90.in:400 + + + end do ! cur_max_pend_req_i2c ! pio_rearr_opts2.F90.in:402 + end do ! cur_enable_isend_i2c ! pio_rearr_opts2.F90.in:403 + end do ! cur_enable_hs_i2c ! pio_rearr_opts2.F90.in:404 + end do ! cur_max_pend_req_c2i ! pio_rearr_opts2.F90.in:405 + end do ! cur_enable_isend_c2i ! pio_rearr_opts2.F90.in:406 + end do ! cur_enable_hs_c2i ! pio_rearr_opts2.F90.in:407 + end do ! cur_fcd_opt ! pio_rearr_opts2.F90.in:408 + end do ! cur_comm_type_opt ! pio_rearr_opts2.F90.in:409 + + + call PIO_closefile(pio_file) ! pio_rearr_opts2.F90.in:411 + call PIO_deletefile(pio_tf_iosystem_, trim(tgv_fname)) ! pio_rearr_opts2.F90.in:412 + end do ! iotypes ! pio_rearr_opts2.F90.in:413 + + + if(allocated(iotypes)) then ! pio_rearr_opts2.F90.in:415 + deallocate(iotypes) ! pio_rearr_opts2.F90.in:416 + deallocate(iotype_descs) ! pio_rearr_opts2.F90.in:417 + end if ! pio_rearr_opts2.F90.in:418 + + +END SUBROUTINE set_rearr_opts_and_write ! pio_rearr_opts2.F90.in:420 + + + SUBROUTINE PIO_TF_Test_driver_ + USE pio_tutil + IMPLICIT NONE + pio_tf_retval_utest_ = 0 + IF (pio_tf_world_rank_ == 0) THEN + PRINT *, "PIO_TF: Starting set_rearr_opts_and_write" + END IF + CALL set_rearr_opts_and_write() + IF (pio_tf_retval_utest_ /= 0) THEN + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + END IF + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "set_rearr_opts_and_write","-----------", "PASSED" + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF:Test 1:",& + "set_rearr_opts_and_write","-----------", "FAILED" + END IF + END IF + END SUBROUTINE PIO_TF_Test_driver_ + + + PROGRAM PIO_TF_Test_main_ + USE pio_tutil + IMPLICIT NONE + INTEGER, PARAMETER :: NREARRS = 2 + INTEGER :: rearrs(NREARRS) = (/pio_rearr_subset,pio_rearr_box/) + CHARACTER(LEN=PIO_TF_MAX_STR_LEN) :: rearrs_info(NREARRS) = (/"PIO_REARR_SUBSET","PIO_REARR_BOX "/) + INTEGER i, ierr + + pio_tf_nerrs_total_=0 + pio_tf_retval_utest_=0 + CALL MPI_Init(ierr) + DO i=1,SIZE(rearrs) + CALL PIO_TF_Init_(rearrs(i)) + IF (pio_tf_world_rank_ == 0) THEN + WRITE(*,*) "PIO_TF: Testing : ", trim(rearrs_info(i)) + END IF + CALL PIO_TF_Test_driver_() + CALL PIO_TF_Finalize_() + END DO + IF (pio_tf_world_rank_ == 0) THEN + IF (pio_tf_nerrs_total_ == 0) THEN + IF (pio_tf_retval_utest_ == 0) THEN + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "All tests", "---------", "PASSED" + ELSE + pio_tf_nerrs_total_ = pio_tf_nerrs_total_ + 1 + WRITE(*,PIO_TF_TEST_RES_FMT) "PIO_TF: ",& + "Test driver", "---------", "FAILED" + END IF + ELSE + WRITE(*,PIO_TF_TEST_RES_FMT2) "PIO_TF:[",& + pio_tf_nerrs_total_,"] Tests",& + "----- FAILED" + END IF + END IF + CALL MPI_Finalize(ierr) + IF (pio_tf_nerrs_total_ /= 0) THEN + STOP 99 + END IF + END PROGRAM diff --git a/tests/general/run_tests.sh b/tests/general/run_tests.sh new file mode 100755 index 00000000000..436a8b264a3 --- /dev/null +++ b/tests/general/run_tests.sh @@ -0,0 +1,27 @@ +#!/bin/sh +# This is a test script for PIO for tests/general directory. +# Ed Hartnett 3/25/19 + +# Stop execution of script if error is returned. +set -e + +# Stop loop if ctrl-c is pressed. +trap exit INT TERM + +printf 'running PIO tests...\n' + +PIO_TESTS='pio_init_finalize' + +success1=true +for TEST in $PIO_TESTS +do + success1=false + echo "running ${TEST}" + mpiexec -n 4 ./${TEST} && success1=true || break +done + +# Did we succeed? +if test x$success1 = xtrue; then + exit 0 +fi +exit 1