From 4f0c73b7b8df267f076e0494ccb0649b457fde59 Mon Sep 17 00:00:00 2001
From: Ed Hartnett <edwardjameshartnett@gmail.com>
Date: Thu, 27 Jun 2019 05:59:43 -0600
Subject: [PATCH 1/4] fixed warning in driver.F90

---
 tests/unit/driver.F90 | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/unit/driver.F90 b/tests/unit/driver.F90
index 266098e4bd1..d3f3a83fd7c 100644
--- a/tests/unit/driver.F90
+++ b/tests/unit/driver.F90
@@ -15,7 +15,7 @@ Program pio_unit_test_driver
 
   ! local variables
   character(len=str_len) :: err_msg
-  integer :: fail_cnt, test_cnt, ios, test_id, ierr, test_val
+  integer :: fail_cnt, test_cnt, ios, test_id, ierr
   logical :: ltest_netcdf, ltest_pnetcdf
   logical :: ltest_netcdf4p, ltest_netcdf4c
   namelist/piotest_nml/  ltest_netcdf,     &

From ddb92ef73c6453cd704d17791850c1fefb6f909b Mon Sep 17 00:00:00 2001
From: Ed Hartnett <edwardjameshartnett@gmail.com>
Date: Thu, 27 Jun 2019 07:14:49 -0600
Subject: [PATCH 2/4] fixed warnings in pio_decomp_frame_tests.F90.in

---
 tests/general/pio_decomp_frame_tests.F90.in | 2383 +++++++++++++++++--
 1 file changed, 2197 insertions(+), 186 deletions(-)

diff --git a/tests/general/pio_decomp_frame_tests.F90.in b/tests/general/pio_decomp_frame_tests.F90.in
index 5b5876fd3a4..791d748052b 100644
--- a/tests/general/pio_decomp_frame_tests.F90.in
+++ b/tests/general/pio_decomp_frame_tests.F90.in
@@ -92,8 +92,10 @@ END SUBROUTINE
 
 ! Write with one decomp (to force rearrangement) and read with another (no
 ! rearrangement)
-PIO_TF_TEMPLATE<PIO_TF_PREDEF_TYPENAME PIO_TF_DATA_TYPE, PIO_TF_PREDEF_TYPENAME PIO_TF_FC_DATA_TYPE>
-PIO_TF_AUTO_TEST_SUB_BEGIN nc_write_read_4d_col_decomp
+
+SUBROUTINE nc_write_read_4d_col_decomp_PIO_int_integer__
+USE pio_tutil
+
   implicit none
   integer, parameter :: NDIMS = 4
   integer, parameter :: NFRAMES = 6
@@ -103,7 +105,7 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_write_read_4d_col_decomp
   type(io_desc_t) :: wr_iodesc, rd_iodesc
   integer, dimension(:), allocatable :: compdof
   integer, dimension(NDIMS) :: start, count
-  PIO_TF_FC_DATA_TYPE, dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val
+  integer, dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val
   integer, dimension(NDIMS-1) :: dims
   integer, dimension(NDIMS) :: pio_dims
   integer :: i, j, k, tmp_idx, ierr, nrows, ncols, nhgts
@@ -112,13 +114,13 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_write_read_4d_col_decomp
   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
@@ -127,27 +129,27 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_write_read_4d_col_decomp
         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))
+          wbuf(i,j,k,f) = wbuf(i,j,k,f) + int(f - 1) * (dims(1) * dims(2) * dims(3))
           tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i
           compdof(tmp_idx) = int(wbuf(i,j,k,1))
         end do
       end do
     end do
   end do
-
-  call PIO_initdecomp(pio_tf_iosystem_, PIO_TF_DATA_TYPE, dims, compdof, wr_iodesc)
+   ! 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
@@ -155,93 +157,197 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_write_read_4d_col_decomp
           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))
+          exp_val(i,j,k,f) = compdof(tmp_idx) + int(f - 1) * (dims(1) * dims(2) * dims(3))
         end do
       end do
     end do
   end do
-
-  call PIO_initdecomp(pio_tf_iosystem_, PIO_TF_DATA_TYPE, dims, compdof, rd_iodesc)
+   ! 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
-    PIO_TF_LOG(0,*) "Testing : PIO_TF_DATA_TYPE : ", iotype_descs(i)
-    ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) 
-    PIO_TF_CHECK_ERR(ierr, "Could not create file " // trim(filename))
 
+    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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
-
-    ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_TF_DATA_TYPE, pio_dims, pio_var)
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a var : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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)
-    PIO_TF_CHECK_ERR(ierr, "Failed to end redef mode : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, 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)
-      PIO_TF_CHECK_ERR(ierr, "Failed to write darray : " // trim(filename))
-    end do
 
+      IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, 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)
-      PIO_TF_CHECK_ERR(ierr, "Failed to read darray : " // trim(filename))
-    end do
 
-    do f=1,NFRAMES
-      PIO_TF_CHECK_VAL((rbuf(:,:,:,f), exp_val(:,:,:,f)), "Got wrong val, frame=", f)
+      IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, 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)
-PIO_TF_AUTO_TEST_SUB_END nc_write_read_4d_col_decomp
+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
 
-! 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)
-PIO_TF_TEMPLATE<PIO_TF_PREDEF_TYPENAME PIO_TF_DATA_TYPE, PIO_TF_PREDEF_TYPENAME PIO_TF_FC_DATA_TYPE>
-PIO_TF_AUTO_TEST_SUB_BEGIN nc_reuse_3d_decomp
   implicit none
   integer, parameter :: NDIMS = 4
-  integer, parameter :: NFRAMES = 3
-  type(var_desc_t)  :: pio_var3d, pio_var4d
+  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
-  PIO_TF_FC_DATA_TYPE, dimension(:,:,:,:), allocatable :: rbuf4d, wbuf4d, exp_val4d
-  PIO_TF_FC_DATA_TYPE, dimension(:,:,:), allocatable :: rbuf3d, wbuf3d, exp_val3d
+  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, nrows, ncols, nhgts
@@ -250,178 +356,230 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_reuse_3d_decomp
   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)
-  
-  ! Initialize the 4d var
-  allocate(wbuf4d(nrows, ncols, nhgts, NFRAMES))
+
+  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
-          wbuf4d(i,j,k,f) = (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +&
+          wbuf(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))
+          wbuf(i,j,k,f) = wbuf(i,j,k,f) + real(f - 1) * real(dims(1) * dims(2) * dims(3))
+          tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i
+          compdof(tmp_idx) = int(wbuf(i,j,k,1))
         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) = int(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
-
-  call PIO_initdecomp(pio_tf_iosystem_, PIO_TF_DATA_TYPE, dims, compdof, wr_iodesc)
+   ! 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(rbuf4d(nrows, ncols, nhgts, NFRAMES))
-  rbuf4d = 0
-  ! Expected val for 4d var
-  allocate(exp_val4d(nrows, ncols, nhgts, NFRAMES))
+
+  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
-          exp_val4d(i,j,k,f) =  (start(3) - 1 + k - 1) * (dims(1) * dims(2)) +&
+          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_val4d(i,j,k,f) = exp_val4d(i,j,k,f)+(f - 1) * (dims(1) * dims(2) * dims(3))
+          exp_val(i,j,k,f) = compdof(tmp_idx) + real(f - 1) * real(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) = int(exp_val4d(i,j,k,1))
-      end do
-    end do
-  end do
-
-  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
-
-  call PIO_initdecomp(pio_tf_iosystem_, PIO_TF_DATA_TYPE, dims, compdof, rd_iodesc)
+   ! 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
-    PIO_TF_LOG(0,*) "Testing : PIO_TF_DATA_TYPE : ", iotype_descs(i)
-    ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) 
-    PIO_TF_CHECK_ERR(ierr, "Could not create file " // trim(filename))
 
+    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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
-
-    ierr = PIO_def_var(pio_file, 'PIO_TF_test_3d_var', PIO_TF_DATA_TYPE, pio_dims(1:3), pio_var3d)
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a 3d var : " // trim(filename))
-
-    ierr = PIO_def_var(pio_file, 'PIO_TF_test_4d_var', PIO_TF_DATA_TYPE, pio_dims, pio_var4d)
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a 4d var : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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)
-    PIO_TF_CHECK_ERR(ierr, "Failed to end redef mode : " // trim(filename))
-
-    call PIO_write_darray(pio_file, pio_var3d, wr_iodesc, wbuf3d, ierr)
-    PIO_TF_CHECK_ERR(ierr, "Failed to write 3d darray : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, 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_var4d, f)
+      call PIO_setframe(pio_file, pio_var, f)
       ! Write the current frame
-      call PIO_write_darray(pio_file, pio_var4d, wr_iodesc, wbuf4d(:,:,:,f), ierr)
-      PIO_TF_CHECK_ERR(ierr, "Failed to write 4d darray : " // trim(filename))
+      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)
-
-    rbuf4d = 0
-    rbuf3d = 0
-
-    call PIO_read_darray(pio_file, pio_var3d, rd_iodesc, rbuf3d, ierr)
-    PIO_TF_CHECK_ERR(ierr, "Failed to read 3d darray : " // trim(filename))
-
+   ! pio_decomp_frame_tests.F90.in:201
     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)
-      PIO_TF_CHECK_ERR(ierr, "Failed to read 4d darray : " // trim(filename))
-    end do
+      call PIO_setframe(pio_file, pio_var, f)
+      call PIO_read_darray(pio_file, pio_var, rd_iodesc, rbuf(:,:,:,f), ierr)
 
-    do f=1,NFRAMES
-      PIO_TF_CHECK_VAL((rbuf4d(:,:,:,f), exp_val4d(:,:,:,f)), "Got wrong 4d val, frame=", f)
+      IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, 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_TF_CHECK_VAL((rbuf3d, exp_val3d), "Got wrong 3dd val")
+   ! 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___
 
-  deallocate(exp_val3d)
-  deallocate(rbuf3d)
-  deallocate(wbuf3d)
 
-  deallocate(exp_val4d)
-  deallocate(rbuf4d)
-  deallocate(wbuf4d)
-PIO_TF_AUTO_TEST_SUB_END nc_reuse_3d_decomp
+SUBROUTINE nc_write_read_4d_col_decomp_PIO_double_real_kind_fc_double___
+USE pio_tutil
 
-! Same as nc_write_read_4d_col_decomp, but use a limited time dimension instead
-PIO_TF_TEMPLATE<PIO_TF_PREDEF_TYPENAME PIO_TF_DATA_TYPE, PIO_TF_PREDEF_TYPENAME PIO_TF_FC_DATA_TYPE>
-PIO_TF_AUTO_TEST_SUB_BEGIN nc_test_limited_time_dim
   implicit none
   integer, parameter :: NDIMS = 4
   integer, parameter :: NFRAMES = 6
@@ -431,7 +589,7 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_test_limited_time_dim
   type(io_desc_t) :: wr_iodesc, rd_iodesc
   integer, dimension(:), allocatable :: compdof
   integer, dimension(NDIMS) :: start, count
-  PIO_TF_FC_DATA_TYPE, dimension(:,:,:,:), allocatable :: rbuf, wbuf, exp_val
+  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, nrows, ncols, nhgts
@@ -440,13 +598,13 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_test_limited_time_dim
   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
@@ -462,20 +620,20 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_test_limited_time_dim
       end do
     end do
   end do
-
-  call PIO_initdecomp(pio_tf_iosystem_, PIO_TF_DATA_TYPE, dims, compdof, wr_iodesc)
+   ! 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
@@ -488,68 +646,1921 @@ PIO_TF_AUTO_TEST_SUB_BEGIN nc_test_limited_time_dim
       end do
     end do
   end do
-
-  call PIO_initdecomp(pio_tf_iosystem_, PIO_TF_DATA_TYPE, dims, compdof, rd_iodesc)
+   ! 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
-    PIO_TF_LOG(0,*) "Testing : PIO_TF_DATA_TYPE : ", iotype_descs(i)
-    ierr = PIO_createfile(pio_tf_iosystem_, pio_file, iotypes(i), filename, PIO_CLOBBER) 
-    PIO_TF_CHECK_ERR(ierr, "Could not create file " // trim(filename))
 
+    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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
-
-    ierr = PIO_def_dim(pio_file, 'PIO_TF_test_dim_time_limited', NFRAMES, pio_dims(4))
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a dim : " // trim(filename))
 
-    ierr = PIO_def_var(pio_file, 'PIO_TF_test_var', PIO_TF_DATA_TYPE, pio_dims, pio_var)
-    PIO_TF_CHECK_ERR(ierr, "Failed to define a var : " // trim(filename))
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, pio_tf_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)
-    PIO_TF_CHECK_ERR(ierr, "Failed to end redef mode : " // trim(filename))
 
+    IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, 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)
-      PIO_TF_CHECK_ERR(ierr, "Failed to write darray : " // trim(filename))
-    end do
 
+      IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, 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)
-      PIO_TF_CHECK_ERR(ierr, "Failed to read darray : " // trim(filename))
-    end do
 
-    do f=1,NFRAMES
-      PIO_TF_CHECK_VAL((rbuf(:,:,:,f), exp_val(:,:,:,f)), "Got wrong val, frame=", f)
+      IF (.NOT. (PIO_TF_Passert_((ierr) == PIO_NOERR, 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, 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:846
+  ! 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) + int(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) = int(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:885
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:888
+  ! 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) + int(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) = int(exp_val4d(i,j,k,1))
+      end do
+    end do
+  end do
+   ! pio_decomp_frame_tests.F90.in:919
+  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:932
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:935
+  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:942)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:943
+    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:945)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:946
+    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:948)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:949
+    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:951)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:952
+    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:954)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:955
+    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:957)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:958
+    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:960)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:961
+    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:963)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:964
+    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:966)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:967
+    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:972)"
+        END IF
+        RETURN
+      END IF
+    end do
+    call PIO_syncfile(pio_file)
+   ! pio_decomp_frame_tests.F90.in:975
+    rbuf4d = 0
+    rbuf3d = 0
+   ! pio_decomp_frame_tests.F90.in:978
+    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:980)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:981
+    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:985)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:987
+    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:989)"
+        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:991)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:992
+    call PIO_closefile(pio_file)
+
+    call PIO_deletefile(pio_tf_iosystem_, filename);
+  end do
+   ! pio_decomp_frame_tests.F90.in:997
+  if(allocated(iotypes)) then
+    deallocate(iotypes)
+    deallocate(iotype_descs)
+  end if
+   ! pio_decomp_frame_tests.F90.in:1002
+  call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc)
+  call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc)
+   ! pio_decomp_frame_tests.F90.in:1005
+  deallocate(exp_val3d)
+  deallocate(rbuf3d)
+  deallocate(wbuf3d)
+   ! pio_decomp_frame_tests.F90.in:1009
+  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, 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:846
+  ! 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) + real(f - 1) * real(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) = int(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:885
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:888
+  ! 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) + real(f - 1) * real(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) = int(exp_val4d(i,j,k,1))
+      end do
+    end do
+  end do
+   ! pio_decomp_frame_tests.F90.in:919
+  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:932
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:935
+  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:942)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:943
+    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:945)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:946
+    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:948)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:949
+    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:951)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:952
+    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:954)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:955
+    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:957)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:958
+    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:960)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:961
+    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:963)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:964
+    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:966)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:967
+    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:972)"
+        END IF
+        RETURN
+      END IF
+    end do
+    call PIO_syncfile(pio_file)
+   ! pio_decomp_frame_tests.F90.in:975
+    rbuf4d = 0
+    rbuf3d = 0
+   ! pio_decomp_frame_tests.F90.in:978
+    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:980)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:981
+    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:985)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:987
+    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:989)"
+        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:991)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:992
+    call PIO_closefile(pio_file)
+
+    call PIO_deletefile(pio_tf_iosystem_, filename);
+  end do
+   ! pio_decomp_frame_tests.F90.in:997
+  if(allocated(iotypes)) then
+    deallocate(iotypes)
+    deallocate(iotype_descs)
+  end if
+   ! pio_decomp_frame_tests.F90.in:1002
+  call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc)
+  call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc)
+   ! pio_decomp_frame_tests.F90.in:1005
+  deallocate(exp_val3d)
+  deallocate(rbuf3d)
+  deallocate(wbuf3d)
+   ! pio_decomp_frame_tests.F90.in:1009
+  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, 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:846
+  ! 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) = int(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:885
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:888
+  ! 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) = int(exp_val4d(i,j,k,1))
+      end do
+    end do
+  end do
+   ! pio_decomp_frame_tests.F90.in:919
+  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:932
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:935
+  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:942)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:943
+    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:945)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:946
+    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:948)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:949
+    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:951)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:952
+    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:954)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:955
+    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:957)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:958
+    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:960)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:961
+    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:963)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:964
+    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:966)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:967
+    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:972)"
+        END IF
+        RETURN
+      END IF
+    end do
+    call PIO_syncfile(pio_file)
+   ! pio_decomp_frame_tests.F90.in:975
+    rbuf4d = 0
+    rbuf3d = 0
+   ! pio_decomp_frame_tests.F90.in:978
+    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:980)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:981
+    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:985)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:987
+    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:989)"
+        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:991)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:992
+    call PIO_closefile(pio_file)
+
+    call PIO_deletefile(pio_tf_iosystem_, filename);
+  end do
+   ! pio_decomp_frame_tests.F90.in:997
+  if(allocated(iotypes)) then
+    deallocate(iotypes)
+    deallocate(iotype_descs)
+  end if
+   ! pio_decomp_frame_tests.F90.in:1002
+  call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc)
+  call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc)
+   ! pio_decomp_frame_tests.F90.in:1005
+  deallocate(exp_val3d)
+  deallocate(rbuf3d)
+  deallocate(wbuf3d)
+   ! pio_decomp_frame_tests.F90.in:1009
+  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:1013
+
+
+! 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, 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:1862
+  ! 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) + int(f - 1) * (dims(1) * dims(2) * dims(3))
+          tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i
+          compdof(tmp_idx) = int(wbuf(i,j,k,1))
+        end do
+      end do
+    end do
+  end do
+   ! pio_decomp_frame_tests.F90.in:1884
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, wr_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:1887
+  ! 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:1897
+  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) + int(f - 1) * (dims(1) * dims(2) * dims(3))
+        end do
+      end do
+    end do
+  end do
+   ! pio_decomp_frame_tests.F90.in:1910
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_int, dims, compdof, rd_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:1913
+  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:1920)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1921
+    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:1923)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1924
+    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:1926)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1927
+    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:1929)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1930
+    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:1932)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1933
+    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:1935)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1936
+    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:1938)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1939
+    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:1944)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1946
+    call PIO_syncfile(pio_file)
+   ! pio_decomp_frame_tests.F90.in:1948
+    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:1952)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1954
+    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:1956)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1958
+    call PIO_closefile(pio_file)
+
+    call PIO_deletefile(pio_tf_iosystem_, filename);
+  end do
+   ! pio_decomp_frame_tests.F90.in:1963
+  if(allocated(iotypes)) then
+    deallocate(iotypes)
+    deallocate(iotype_descs)
+  end if
+   ! pio_decomp_frame_tests.F90.in:1968
+  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, 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:1862
+  ! 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) + real(f - 1) * real(dims(1) * dims(2) * dims(3))
+          tmp_idx = (k - 1) * (ncols * nrows) + (j - 1) * nrows + i
+          compdof(tmp_idx) = int(wbuf(i,j,k,1))
+        end do
+      end do
+    end do
+  end do
+   ! pio_decomp_frame_tests.F90.in:1884
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, wr_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:1887
+  ! 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:1897
+  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) + real(f - 1) * real(dims(1) * dims(2) * dims(3))
+        end do
+      end do
+    end do
+  end do
+   ! pio_decomp_frame_tests.F90.in:1910
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_real, dims, compdof, rd_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:1913
+  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:1920)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1921
+    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:1923)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1924
+    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:1926)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1927
+    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:1929)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1930
+    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:1932)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1933
+    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:1935)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1936
+    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:1938)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1939
+    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:1944)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1946
+    call PIO_syncfile(pio_file)
+   ! pio_decomp_frame_tests.F90.in:1948
+    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:1952)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1954
+    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:1956)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1958
+    call PIO_closefile(pio_file)
+
+    call PIO_deletefile(pio_tf_iosystem_, filename);
+  end do
+   ! pio_decomp_frame_tests.F90.in:1963
+  if(allocated(iotypes)) then
+    deallocate(iotypes)
+    deallocate(iotype_descs)
+  end if
+   ! pio_decomp_frame_tests.F90.in:1968
+  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, 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:1862
+  ! 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) = int(wbuf(i,j,k,1))
+        end do
+      end do
+    end do
+  end do
+   ! pio_decomp_frame_tests.F90.in:1884
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, wr_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:1887
+  ! 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:1897
+  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:1910
+  call PIO_initdecomp(pio_tf_iosystem_, PIO_double, dims, compdof, rd_iodesc)
+  deallocate(compdof)
+   ! pio_decomp_frame_tests.F90.in:1913
+  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:1920)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1921
+    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:1923)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1924
+    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:1926)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1927
+    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:1929)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1930
+    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:1932)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1933
+    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:1935)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1936
+    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:1938)"
+      END IF
+      RETURN
+    END IF
+   ! pio_decomp_frame_tests.F90.in:1939
+    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:1944)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1946
+    call PIO_syncfile(pio_file)
+   ! pio_decomp_frame_tests.F90.in:1948
+    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:1952)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1954
+    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:1956)"
+        END IF
+        RETURN
+      END IF
+    end do
+   ! pio_decomp_frame_tests.F90.in:1958
+    call PIO_closefile(pio_file)
+
+    call PIO_deletefile(pio_tf_iosystem_, filename);
+  end do
+   ! pio_decomp_frame_tests.F90.in:1963
+  if(allocated(iotypes)) then
+    deallocate(iotypes)
+    deallocate(iotype_descs)
+  end if
+   ! pio_decomp_frame_tests.F90.in:1968
   call PIO_freedecomp(pio_tf_iosystem_, rd_iodesc)
   call PIO_freedecomp(pio_tf_iosystem_, wr_iodesc)
   deallocate(exp_val)
   deallocate(rbuf)
   deallocate(wbuf)
-PIO_TF_AUTO_TEST_SUB_END nc_test_limited_time_dim
+END SUBROUTINE nc_test_limited_time_dim_PIO_double_real_kind_fc_double___

From 82d900ae030fc11ce3e5cddff88d34f3a932cec4 Mon Sep 17 00:00:00 2001
From: Ed Hartnett <edwardjameshartnett@gmail.com>
Date: Thu, 27 Jun 2019 07:36:47 -0600
Subject: [PATCH 3/4] fixed warnings in piodarray.F90.in

---
 src/flib/piodarray.F90.in | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/flib/piodarray.F90.in b/src/flib/piodarray.F90.in
index 3fe4e8904c1..8569878c688 100644
--- a/src/flib/piodarray.F90.in
+++ b/src/flib/piodarray.F90.in
@@ -59,9 +59,9 @@ interface
         bind(C,name="PIOc_write_darray_multi")
      use iso_c_binding
      integer(C_INT), value :: ncid
+     integer(C_INT), value :: nvars
      integer(C_INT) :: vid(nvars)
      integer(C_INT), value :: ioid
-     integer(C_INT), value :: nvars
      integer(C_SIZE_T), value :: arraylen
      type(c_ptr), value :: array
      type(C_PTR), value :: fillvalue

From f9fa38bc9ffd1b569a0cc0bf8da6280687808f20 Mon Sep 17 00:00:00 2001
From: Ed Hartnett <edwardjameshartnett@gmail.com>
Date: Thu, 27 Jun 2019 07:39:58 -0600
Subject: [PATCH 4/4] removed some dead code

---
 src/flib/piolib_mod.F90 | 68 -----------------------------------------
 1 file changed, 68 deletions(-)

diff --git a/src/flib/piolib_mod.F90 b/src/flib/piolib_mod.F90
index 0f49a61ca50..11319bb603c 100644
--- a/src/flib/piolib_mod.F90
+++ b/src/flib/piolib_mod.F90
@@ -187,10 +187,7 @@ module piolib_mod
      module procedure initdecomp_1dof_bin_i8
      module procedure initdecomp_2dof_nf_i4
      module procedure initdecomp_2dof_nf_i8
-!     module procedure initdecomp_2dof_bin_i4
-!     module procedure initdecomp_2dof_bin_i8
      module procedure PIO_initdecomp_bc
-     !     module procedure PIO_initdecomp_dof_dof
   end interface PIO_initdecomp
 
   !>
@@ -527,75 +524,10 @@ end function PIOc_InitDecomp_bc
     ierr = PIOc_InitDecomp_bc(iosystem%iosysid, basepiotype, ndims, cdims, &
          cstart, ccount, iodesc%ioid)
 
-
     deallocate(cstart, ccount, cdims)
 
-
   end subroutine PIO_initdecomp_bc
 
-  ! !>
-  ! !! @public
-  ! !! @ingroup PIO_initdecomp
-  ! !! A deprecated interface to the PIO_initdecomp method.
-  ! !!
-  ! !! @param iosystem a defined pio system descriptor, see PIO_types
-  ! !! @param basepiotype the type of variable(s) associated with this iodesc.
-  ! !! @copydoc PIO_kinds
-  ! !! @param dims an array of the global length of each dimesion of the variable(s)
-  ! !! @param lenblocks
-  ! !! @param compdof mapping of the storage order of the variable to its memory order
-  ! !! @param iodofr
-  ! !! @param iodofw
-  ! !! @param iodesc @copydoc iodesc_generate
-  ! !! @deprecated
-  ! !! @author Jim Edwards
-  ! !<
-  ! subroutine initdecomp_2dof_bin_i4(iosystem,basepiotype,dims,lenblocks,compdof,iodofr,iodofw,iodesc)
-  !   type (iosystem_desc_t), intent(in) :: iosystem
-  !   integer(i4), intent(in)           :: basepiotype
-  !   integer(i4), intent(in)           :: dims(:)
-  !   integer (i4), intent(in)          :: lenblocks
-  !   integer (i4), intent(in)          :: compdof(:)   !> global degrees of freedom for computational decomposition
-  !   integer (i4), intent(in)          :: iodofr(:)     !> global degrees of freedom for io decomposition
-  !   integer (i4), intent(in)          :: iodofw(:)     !> global degrees of freedom for io decomposition
-  !   type (io_desc_t), intent(inout)     :: iodesc
-
-
-  !   call initdecomp_2dof_bin_i8(iosystem,basepiotype,dims,lenblocks,int(compdof,PIO_OFFSET_KIND),int(iodofr,PIO_OFFSET_KIND), &
-  !        int(iodofw,PIO_OFFSET_KIND),iodesc)
-
-  ! end subroutine initdecomp_2dof_bin_i4
-
-  ! !>
-  ! !! @public
-  ! !! @ingroup PIO_initdecomp
-  ! !! A deprecated interface to the PIO_initdecomp method.
-  ! !!
-  ! !! @param iosystem a defined pio system descriptor, see PIO_types
-  ! !! @param basepiotype the type of variable(s) associated with this iodesc.
-  ! !! @copydoc PIO_kinds
-  ! !! @param dims an array of the global length of each dimesion of the variable(s)
-  ! !! @param lenblocks
-  ! !! @param compdof mapping of the storage order of the variable to its memory order
-  ! !! @param iodofr
-  ! !! @param iodofw
-  ! !! @param iodesc @copydoc iodesc_generate
-  ! !! @deprecated
-  ! !! @author Jim Edwards
-  ! !<
-  ! subroutine initdecomp_2dof_bin_i8(iosystem,basepiotype,dims,lenblocks,compdof,iodofr,iodofw,iodesc)
-  !   !    use calcdisplace_mod, only : calcdisplace
-  !   type (iosystem_desc_t), intent(in) :: iosystem
-  !   integer(i4), intent(in)           :: basepiotype
-  !   integer(i4), intent(in)           :: dims(:)
-  !   integer (i4), intent(in)          :: lenblocks
-  !   integer (PIO_OFFSET_KIND), intent(in)          :: compdof(:)   !> global degrees of freedom for computational decomposition
-  !   integer (PIO_OFFSET_KIND), intent(in)          :: iodofr(:)     !> global degrees of freedom for io decomposition
-  !   integer (PIO_OFFSET_KIND), intent(in)          :: iodofw(:)     !> global degrees of freedom for io decomposition
-  !   type (io_desc_t), intent(inout)     :: iodesc
-
-  ! end subroutine initdecomp_2dof_bin_i8
-
   !>
   !! @public
   !! @ingroup PIO_initdecomp