From 1c0464bb4bcf1d6b6a2e784a376b625f08d3afa9 Mon Sep 17 00:00:00 2001 From: Ed Hartnett Date: Tue, 26 Mar 2019 13:03:02 -0600 Subject: [PATCH] now generating F90 files in tests/general --- configure.ac | 20 - tests/general/Makefile.am | 33 +- 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 --- 21 files changed, 24 insertions(+), 24729 deletions(-) delete mode 100644 tests/general/ncdf_fail.F90.in2 delete mode 100644 tests/general/ncdf_get_put.F90.in2 delete mode 100644 tests/general/ncdf_inq.F90.in2 delete mode 100644 tests/general/ncdf_simple_tests.F90.in2 delete mode 100644 tests/general/pio_decomp_fillval.F90.in2 delete mode 100644 tests/general/pio_decomp_frame_tests.F90.in2 delete mode 100644 tests/general/pio_decomp_tests.F90.in2 delete mode 100644 tests/general/pio_decomp_tests_1d.F90.in2 delete mode 100644 tests/general/pio_decomp_tests_2d.F90.in2 delete mode 100644 tests/general/pio_decomp_tests_3d.F90.in2 delete mode 100644 tests/general/pio_file_fail.F90.in2 delete mode 100644 tests/general/pio_file_simple_tests.F90.in2 delete mode 100644 tests/general/pio_init_finalize.F90.in2 delete mode 100644 tests/general/pio_iosystem_tests.F90.in2 delete mode 100644 tests/general/pio_iosystem_tests2.F90.in2 delete mode 100644 tests/general/pio_iosystem_tests3.F90.in2 delete mode 100644 tests/general/pio_rearr.F90.in2 delete mode 100644 tests/general/pio_rearr_opts.F90.in2 delete mode 100644 tests/general/pio_rearr_opts2.F90.in2 diff --git a/configure.ac b/configure.ac index 833def0039b..716fa6f0121 100644 --- a/configure.ac +++ b/configure.ac @@ -125,26 +125,6 @@ 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) -AC_CONFIG_FILES(tests/general/pio_tutil.F90:tests/general/util/pio_tutil.F90) AC_CONFIG_LINKS([tests/unit/input.nl:tests/unit/input.nl]) diff --git a/tests/general/Makefile.am b/tests/general/Makefile.am index a60bac6b996..a8e4b11354d 100644 --- a/tests/general/Makefile.am +++ b/tests/general/Makefile.am @@ -63,16 +63,31 @@ pio_iosystem_tests3_SOURCES = pio_iosystem_tests3.F90 # Tests will run from a bash script. TESTS = run_tests.sh +%.F90: %.F90.in + util/pio_tf_f90gen.pl --annotate-source --out=$@ $< + +ncdf_fail.F90: ncdf_fail.F90.in +ncdf_get_put.F90: ncdf_get_put.F90.in +ncdf_inq.F90: ncdf_inq.F90.in +ncdf_simple_tests.F90:ncdf_simple_tests.F90.in +pio_decomp_fillval.F90:pio_decomp_fillval.F90.in +pio_decomp_frame_tests.F90:pio_decomp_frame_tests.F90.in +pio_decomp_tests_1d.F90:pio_decomp_tests_1d.F90.in +pio_decomp_tests_2d.F90:pio_decomp_tests_2d.F90.in +pio_decomp_tests_3d.F90:pio_decomp_tests_3d.F90.in +pio_decomp_tests.F90:pio_decomp_tests.F90.in +pio_file_fail.F90:pio_file_fail.F90.in +pio_file_simple_tests.F90:pio_file_simple_tests.F90.in +pio_init_finalize.F90:pio_init_finalize.F90.in +pio_iosystem_tests2.F90:pio_iosystem_tests2.F90.in +pio_iosystem_tests3.F90:pio_iosystem_tests3.F90.in +pio_iosystem_tests.F90:pio_iosystem_tests.F90.in +pio_rearr.F90:pio_rearr.F90.in +pio_rearr_opts2.F90:pio_rearr_opts2.F90.in +pio_rearr_opts.F90:pio_rearr_opts.F90.in + # Distribute the test script. -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 +EXTRA_DIST = CMakeLists.txt run_tests.sh # Clean up files produced during testing. CLEANFILES = *.nc *.log *.mod diff --git a/tests/general/ncdf_fail.F90.in2 b/tests/general/ncdf_fail.F90.in2 deleted file mode 100644 index d6990cfc98c..00000000000 --- a/tests/general/ncdf_fail.F90.in2 +++ /dev/null @@ -1,334 +0,0 @@ -! 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 deleted file mode 100644 index f1267c61264..00000000000 --- a/tests/general/ncdf_get_put.F90.in2 +++ /dev/null @@ -1,5652 +0,0 @@ -! 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 deleted file mode 100644 index 66517f13fa2..00000000000 --- a/tests/general/ncdf_inq.F90.in2 +++ /dev/null @@ -1,577 +0,0 @@ -! 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 deleted file mode 100644 index 0021d053064..00000000000 --- a/tests/general/ncdf_simple_tests.F90.in2 +++ /dev/null @@ -1,950 +0,0 @@ -! 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 deleted file mode 100644 index 27c9889e42b..00000000000 --- a/tests/general/pio_decomp_fillval.F90.in2 +++ /dev/null @@ -1,2709 +0,0 @@ -! 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 deleted file mode 100644 index d605b948dfc..00000000000 --- a/tests/general/pio_decomp_frame_tests.F90.in2 +++ /dev/null @@ -1,2935 +0,0 @@ -! 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 deleted file mode 100644 index de2595a4b31..00000000000 --- a/tests/general/pio_decomp_tests.F90.in2 +++ /dev/null @@ -1,2210 +0,0 @@ -! 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 deleted file mode 100644 index 7521112d4e7..00000000000 --- a/tests/general/pio_decomp_tests_1d.F90.in2 +++ /dev/null @@ -1,2302 +0,0 @@ -! 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 deleted file mode 100644 index 24b998dc790..00000000000 --- a/tests/general/pio_decomp_tests_2d.F90.in2 +++ /dev/null @@ -1,1537 +0,0 @@ -! 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 deleted file mode 100644 index e4ca9da599b..00000000000 --- a/tests/general/pio_decomp_tests_3d.F90.in2 +++ /dev/null @@ -1,846 +0,0 @@ -! 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 deleted file mode 100644 index 212833072b8..00000000000 --- a/tests/general/pio_file_fail.F90.in2 +++ /dev/null @@ -1,179 +0,0 @@ -! 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 deleted file mode 100644 index 0f59bc0afb1..00000000000 --- a/tests/general/pio_file_simple_tests.F90.in2 +++ /dev/null @@ -1,234 +0,0 @@ -! 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 deleted file mode 100644 index 8f4f968959a..00000000000 --- a/tests/general/pio_init_finalize.F90.in2 +++ /dev/null @@ -1,79 +0,0 @@ -! 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 deleted file mode 100644 index 34441734e46..00000000000 --- a/tests/general/pio_iosystem_tests.F90.in2 +++ /dev/null @@ -1,665 +0,0 @@ -! 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 deleted file mode 100644 index 955c67684f0..00000000000 --- a/tests/general/pio_iosystem_tests2.F90.in2 +++ /dev/null @@ -1,530 +0,0 @@ -! 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 deleted file mode 100644 index 3ea5a3d9a97..00000000000 --- a/tests/general/pio_iosystem_tests3.F90.in2 +++ /dev/null @@ -1,576 +0,0 @@ -! 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 deleted file mode 100644 index d9b1c46c1ba..00000000000 --- a/tests/general/pio_rearr.F90.in2 +++ /dev/null @@ -1,623 +0,0 @@ -! 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 deleted file mode 100644 index 276326f4c6b..00000000000 --- a/tests/general/pio_rearr_opts.F90.in2 +++ /dev/null @@ -1,940 +0,0 @@ -! 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 deleted file mode 100644 index 4679ace5893..00000000000 --- a/tests/general/pio_rearr_opts2.F90.in2 +++ /dev/null @@ -1,822 +0,0 @@ -! 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