summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2008-09-23 21:51:07 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2008-09-23 21:51:07 (GMT)
commit9b4a0aea49bc59063e066ae73c006525d71fb81a (patch)
tree3ad9e730284126b5a3027f97f65e8e2f5f7e2b75 /fortran
parent44e038362ba43d2f247fb08ab6dca4b2140a9d15 (diff)
downloadhdf5-9b4a0aea49bc59063e066ae73c006525d71fb81a.zip
hdf5-9b4a0aea49bc59063e066ae73c006525d71fb81a.tar.gz
hdf5-9b4a0aea49bc59063e066ae73c006525d71fb81a.tar.bz2
[svn-r15687] Description:
Fixed nh5sget_select_hyper_blocklist_c nh5sget_select_elem_pointlist_ for bug 1319. by transposing arrays for C-FORTRAN convention.
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Sf.c52
-rw-r--r--fortran/src/H5Sff.f9039
2 files changed, 64 insertions, 27 deletions
diff --git a/fortran/src/H5Sf.c b/fortran/src/H5Sf.c
index 5cf5b51..7b37756 100644
--- a/fortran/src/H5Sf.c
+++ b/fortran/src/H5Sf.c
@@ -210,7 +210,9 @@ nh5sget_select_elem_npoints_c( hid_t_f *space_id , hssize_t_f * num_points)
* Returns: 0 on success, -1 on failure
* Programmer: Xiangyang Su
* Monday, November 15, 1999
- * Modifications:
+ * Modifications:
+ * Transpose dimension arrays because of C-FORTRAN storage order
+ * M.S. Breitenfeld
*---------------------------------------------------------------------------*/
int_f
@@ -222,6 +224,7 @@ nh5sget_select_hyper_blocklist_c( hid_t_f *space_id ,hsize_t_f * startblock,
hsize_t c_num_blocks;
hsize_t i;
+ int j,k,m,n;
int rank;
hsize_t c_startblock, *c_buf;
@@ -237,10 +240,23 @@ nh5sget_select_hyper_blocklist_c( hid_t_f *space_id ,hsize_t_f * startblock,
ret_value = H5Sget_select_hyper_blocklist(c_space_id, c_startblock,
c_num_blocks, c_buf);
- for(i = 0; i < c_num_blocks*2*rank; i++)
- {
- buf[i] = (hsize_t_f)c_buf[i] +1;
+
+ /*
+ * Transpose dimension arrays because of C-FORTRAN storage order and add 1
+ */
+ n = 0;
+ m = 0;
+ for (i=0; i < c_num_blocks; i++) {
+ for (j=0; j < rank; j++) {
+ for (k=0; k < rank; k++) {
+ int t= (m + rank - k - 1);
+ buf[n] = (hsize_t_f)c_buf[t]+1;
+ n = n + 1;
+ }
+ m = m + rank;
+ }
}
+
HDfree(c_buf);
if (ret_value >= 0 ) ret_value = 0;
return ret_value;
@@ -321,8 +337,9 @@ nh5sget_select_elem_pointlist_c( hid_t_f *space_id ,hsize_t_f * startpoint,
hid_t c_space_id;
hsize_t c_num_points;
hsize_t c_startpoint,* c_buf;
+ hsize_t i, i1;
int rank;
- hssize_t i;
+ int j,i2;
c_space_id = *space_id;
c_num_points = (hsize_t)* numpoints;
@@ -335,10 +352,23 @@ nh5sget_select_elem_pointlist_c( hid_t_f *space_id ,hsize_t_f * startpoint,
if (!c_buf) return ret_value;
ret_value = H5Sget_select_elem_pointlist(c_space_id, c_startpoint,
c_num_points, c_buf);
- for (i = (c_num_points*rank)-1; i >= 0; i--) {
- buf[i] = (hsize_t_f)(c_buf[i]+1);
+
+ /* re-arrange the return buffer to account for Fortran ordering of 2D arrays */
+ /* and add 1 to account for array's starting at one in Fortran */
+ i2 = 0;
+ for( i = 0; i < c_num_points; i++) {
+ i1 = rank*(i+1);
+ for(j = 0; j < rank; j++) {
+ buf[i2] = (hsize_t_f)(c_buf[i1-1]+1);
+ i2 = i2 + 1;
+ i1 = i1 - 1;
+ }
}
+/* for( i = 0; i < c_num_points*rank; i++) { */
+/* printf("%i \n", (int)c_buf[i]+1); */
+/* } */
+
if (ret_value >= 0 ) ret_value = 0;
HDfree(c_buf);
@@ -464,7 +494,7 @@ nh5sget_select_npoints_c ( hid_t_f *space_id , hssize_t_f *npoints )
c_space_id = *space_id;
c_npoints = H5Sget_select_npoints(c_space_id);
- if ( c_npoints == 0 ) ret_value = -1;
+ if ( c_npoints < 0 ) ret_value = -1;
*npoints = (hssize_t_f)c_npoints;
return ret_value;
}
@@ -1006,8 +1036,10 @@ nh5sselect_elements_c ( hid_t_f *space_id , int_f *op, size_t_f *nelements, hsi
/*
if (*op != H5S_SELECT_SET_F) return ret_value;
*/
- if (*op != H5S_SELECT_SET) return ret_value;
- c_op = H5S_SELECT_SET;
+/* if (*op != H5S_SELECT_SET) return ret_value; */
+/* c_op = H5S_SELECT_SET; */
+
+ c_op = (H5S_seloper_t)*op;
c_space_id = *space_id;
rank = H5Sget_simple_extent_ndims(c_space_id);
diff --git a/fortran/src/H5Sff.f90 b/fortran/src/H5Sff.f90
index d21b9e1..003b946 100644
--- a/fortran/src/H5Sff.f90
+++ b/fortran/src/H5Sff.f90
@@ -507,9 +507,6 @@
!List of element points selected
INTEGER, INTENT(OUT) :: hdferr ! Error code
-! INTEGER, EXTERNAL :: h5sget_select_elem_pointlist_c
-! MS FORTRAN needs explicit interface for C functions called here.
-!
INTERFACE
INTEGER FUNCTION h5sget_select_elem_pointlist_c(space_id, startpoint, &
num_points, buf )
@@ -526,6 +523,7 @@
hdferr = h5sget_select_elem_pointlist_c(space_id, startpoint, &
num_points, buf )
+
END SUBROUTINE h5sget_select_elem_pointlist_f
!----------------------------------------------------------------------
@@ -568,7 +566,7 @@
! H5S_SELECT_OR_F (1)
INTEGER, INTENT(IN) :: rank ! Number of dataspace dimensions
INTEGER(SIZE_T), INTENT(IN) :: num_elements ! Number of elements to be
- ! selected
+ ! selected
INTEGER(HSIZE_T), &
DIMENSION(rank,num_elements), INTENT(IN) :: coord
! Array with the coordinates
@@ -578,9 +576,6 @@
INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:,:) :: c_coord
INTEGER :: error, i,j
-! INTEGER, EXTERNAL :: h5sselect_elements_c
-! MS FORTRAN needs explicit interface for C functions called here.
-!
INTERFACE
INTEGER FUNCTION h5sselect_elements_c(space_id, operator,&
num_elements,c_c_coord)
@@ -595,17 +590,27 @@
END FUNCTION h5sselect_elements_c
END INTERFACE
- allocate(c_coord(rank, num_elements), stat = error)
- if (error.NE. 0) then
- hdferr = -1
- return
- endif
- do i = 1, rank
+ ALLOCATE(c_coord(rank,num_elements), stat = error)
+ IF (error.NE. 0) THEN
+ hdferr = -1
+ RETURN
+ ENDIF
+ DO i = 1, rank
c_coord(i,:) = coord(rank-i+1, :) - 1
- enddo
- hdferr = h5sselect_elements_c(space_id, operator, num_elements, &
- c_coord)
- deallocate(c_coord)
+ ENDDO
+ hdferr = h5sselect_elements_c(space_id, OPERATOR, num_elements, c_coord)
+
+! ALLOCATE(c_coord(num_elements,rank), stat = error)
+! IF (error.NE. 0) THEN
+! hdferr = -1
+! RETURN
+! ENDIF
+!
+! c_coord = TRANSPOSE(coord)
+! hdferr = h5sselect_elements_c(space_id, OPERATOR, INT(rank,size_t), c_coord)
+
+
+ DEALLOCATE(c_coord)
END SUBROUTINE h5sselect_elements_f