Skip to content

Commit

Permalink
Attempt to quiet some warnings with cray compilers. (#3724)
Browse files Browse the repository at this point in the history
  • Loading branch information
brtnfld authored Oct 19, 2023
1 parent 8c69566 commit 5672fd8
Show file tree
Hide file tree
Showing 12 changed files with 15 additions and 64 deletions.
8 changes: 1 addition & 7 deletions fortran/test/tH5D.F90
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,7 @@ MODULE TH5D
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
USE TH5_MISC_GEN
USE ISO_C_BINDING

CONTAINS
SUBROUTINE datasettest(cleanup, total_error)
Expand Down Expand Up @@ -514,8 +515,6 @@ END SUBROUTINE extenddsettest

SUBROUTINE test_userblock_offset(cleanup, total_error)

USE ISO_C_BINDING

IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
Expand Down Expand Up @@ -631,16 +630,13 @@ END SUBROUTINE test_userblock_offset

SUBROUTINE test_dset_fill(cleanup, total_error)

USE ISO_C_BINDING

IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error

INTEGER, PARAMETER :: DIM0=10
INTEGER, PARAMETER :: int_kind_1 = SELECTED_INT_KIND(2) !should map to INTEGER*1 on most modern processors
INTEGER, PARAMETER :: int_kind_4 = SELECTED_INT_KIND(4) !should map to INTEGER*2 on most modern processors
INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(9) !should map to INTEGER*4 on most modern processors
INTEGER, PARAMETER :: int_kind_16 = SELECTED_INT_KIND(18) !should map to INTEGER*8 on most modern processors
INTEGER(KIND=int_kind_1) , DIMENSION(1:DIM0), TARGET :: data_i1
INTEGER(KIND=int_kind_4) , DIMENSION(1:DIM0), TARGET :: data_i4
Expand Down Expand Up @@ -991,8 +987,6 @@ END SUBROUTINE test_dset_fill

SUBROUTINE test_direct_chunk_io(cleanup, total_error)

USE ISO_C_BINDING

IMPLICIT NONE

LOGICAL, INTENT(IN) :: cleanup
Expand Down
8 changes: 3 additions & 5 deletions fortran/test/tH5E_F03.F90
Original file line number Diff line number Diff line change
Expand Up @@ -92,17 +92,15 @@ END FUNCTION my_hdf5_error_handler_nodata

END MODULE test_my_hdf5_error_handler



MODULE TH5E_F03

USE ISO_C_BINDING
USE test_my_hdf5_error_handler

CONTAINS

SUBROUTINE test_error(total_error)

USE ISO_C_BINDING
USE test_my_hdf5_error_handler

IMPLICIT NONE

INTEGER(hid_t), PARAMETER :: FAKE_ID = -1
Expand Down
18 changes: 0 additions & 18 deletions fortran/test/tH5F.F90
Original file line number Diff line number Diff line change
Expand Up @@ -44,8 +44,6 @@ MODULE TH5F
CONTAINS

SUBROUTINE h5openclose(total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error

Expand Down Expand Up @@ -141,8 +139,6 @@ SUBROUTINE h5openclose(total_error)
END SUBROUTINE h5openclose

SUBROUTINE mountingtest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
Expand Down Expand Up @@ -502,8 +498,6 @@ END SUBROUTINE mountingtest
!

SUBROUTINE reopentest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
Expand Down Expand Up @@ -690,8 +684,6 @@ END SUBROUTINE reopentest
! correct output for a given obj_id and filename.
!
SUBROUTINE check_get_name(obj_id, fix_filename, len_filename, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
INTEGER(HID_T) :: obj_id ! Object identifier
CHARACTER(LEN=80), INTENT(IN) :: fix_filename ! Expected filename
Expand Down Expand Up @@ -780,8 +772,6 @@ END SUBROUTINE check_get_name
!

SUBROUTINE get_name_test(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
Expand Down Expand Up @@ -846,8 +836,6 @@ END SUBROUTINE get_name_test
! created using the got property lists

SUBROUTINE plisttest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
Expand Down Expand Up @@ -946,8 +934,6 @@ END SUBROUTINE plisttest
!

SUBROUTINE file_close(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
Expand Down Expand Up @@ -1075,8 +1061,6 @@ END SUBROUTINE file_close
!

SUBROUTINE file_space(filename, cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
CHARACTER(*), INTENT(IN) :: filename
LOGICAL, INTENT(IN) :: cleanup
Expand Down Expand Up @@ -1168,8 +1152,6 @@ END SUBROUTINE file_space
!

SUBROUTINE test_file_info(filename, cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
IMPLICIT NONE
CHARACTER(*), INTENT(IN) :: filename
LOGICAL, INTENT(IN) :: cleanup
Expand Down
6 changes: 3 additions & 3 deletions fortran/test/tH5G.F90
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,9 @@

MODULE TH5G

USE HDF5 ! This module contains all necessary modules
USE TH5_MISC

CONTAINS

SUBROUTINE group_test(cleanup, total_error)
Expand All @@ -35,9 +38,6 @@ SUBROUTINE group_test(cleanup, total_error)
! h5glink(2)_f, h5gunlink_f, h5gmove(2)_f, h5gget_linkval_f, h5gset_comment_f,
! h5gget_comment_f

USE HDF5 ! This module contains all necessary modules
USE TH5_MISC

IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
Expand Down
17 changes: 5 additions & 12 deletions fortran/test/tH5O_F03.F90
Original file line number Diff line number Diff line change
Expand Up @@ -267,6 +267,10 @@ END MODULE visit_cb

MODULE TH5O_F03

USE HDF5
USE TH5_MISC
USE ISO_C_BINDING

CONTAINS
!***************************************************************
!**
Expand All @@ -276,9 +280,6 @@ MODULE TH5O_F03

SUBROUTINE test_h5o_refcount(total_error)

USE HDF5
USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE

INTEGER, INTENT(INOUT) :: total_error
Expand Down Expand Up @@ -415,11 +416,8 @@ END SUBROUTINE test_h5o_refcount

SUBROUTINE test_obj_visit(total_error)

USE HDF5
USE TH5_MISC

USE visit_cb
USE ISO_C_BINDING

IMPLICIT NONE

INTEGER, INTENT(INOUT) :: total_error
Expand Down Expand Up @@ -553,9 +551,6 @@ END SUBROUTINE test_obj_visit

SUBROUTINE test_obj_info(total_error)

USE HDF5
USE TH5_MISC
USE ISO_C_BINDING
IMPLICIT NONE

INTEGER, INTENT(INOUT) :: total_error
Expand Down Expand Up @@ -702,8 +697,6 @@ END SUBROUTINE test_obj_info

SUBROUTINE build_visit_file(fid)

USE HDF5
USE TH5_MISC
IMPLICIT NONE

INTEGER(hid_t) :: fid ! File ID
Expand Down
2 changes: 0 additions & 2 deletions fortran/test/tH5P_F03.F90
Original file line number Diff line number Diff line change
Expand Up @@ -439,7 +439,6 @@ END SUBROUTINE test_genprop_class_callback

SUBROUTINE test_h5p_file_image(total_error)

USE, INTRINSIC :: iso_c_binding
IMPLICIT NONE
INTEGER, INTENT(INOUT) :: total_error
INTEGER(hid_t) :: fapl_1 = -1
Expand Down Expand Up @@ -653,7 +652,6 @@ END SUBROUTINE external_test_offset
!
SUBROUTINE test_vds(total_error)

USE ISO_C_BINDING
IMPLICIT NONE

INTEGER, INTENT(INOUT) :: total_error
Expand Down
3 changes: 0 additions & 3 deletions fortran/test/tH5Sselect.F90
Original file line number Diff line number Diff line change
Expand Up @@ -319,9 +319,6 @@ END SUBROUTINE test_select_hyperslab

SUBROUTINE test_select_element(cleanup, total_error)

USE HDF5 ! This module contains all necessary modules
USE TH5_MISC

IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
Expand Down
2 changes: 0 additions & 2 deletions fortran/test/tH5T.F90
Original file line number Diff line number Diff line change
Expand Up @@ -819,8 +819,6 @@ END SUBROUTINE basic_data_type_test

SUBROUTINE enumtest(cleanup, total_error)

USE HDF5
USE TH5_MISC
IMPLICIT NONE

LOGICAL, INTENT(IN) :: cleanup
Expand Down
2 changes: 0 additions & 2 deletions fortran/test/tH5T_F03.F90
Original file line number Diff line number Diff line change
Expand Up @@ -3407,8 +3407,6 @@ SUBROUTINE multiple_dset_rw(total_error)
! Failure: number of errors
!-------------------------------------------------------------------------
!
USE iso_c_binding
USE hdf5
IMPLICIT NONE

INTEGER, INTENT(INOUT) :: total_error ! number of errors
Expand Down
8 changes: 3 additions & 5 deletions fortran/test/tH5Z.F90
Original file line number Diff line number Diff line change
Expand Up @@ -25,15 +25,15 @@
!*****
MODULE TH5Z

USE HDF5 ! This module contains all necessary modules
USE TH5_MISC

CONTAINS

SUBROUTINE filters_test(total_error)

! This subroutine tests following functionalities: h5zfilter_avail_f, h5zunregister_f

USE HDF5 ! This module contains all necessary modules
USE TH5_MISC

IMPLICIT NONE
INTEGER, INTENT(OUT) :: total_error
LOGICAL :: status
Expand Down Expand Up @@ -164,8 +164,6 @@ SUBROUTINE filters_test(total_error)
END SUBROUTINE filters_test

SUBROUTINE szip_test(szip_flag, cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC

IMPLICIT NONE
LOGICAL, INTENT(OUT) :: szip_flag
Expand Down
1 change: 0 additions & 1 deletion fortran/test/vol_connector.F90
Original file line number Diff line number Diff line change
Expand Up @@ -227,7 +227,6 @@ END MODULE VOL_TMOD

PROGRAM vol_connector

USE HDF5
USE VOL_TMOD

IMPLICIT NONE
Expand Down
4 changes: 0 additions & 4 deletions fortran/testpar/async.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1240,10 +1240,6 @@ END MODULE test_async_APIs
!
PROGRAM async_test
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_INT64_T
USE HDF5
USE MPI
USE TH5_MISC
USE TH5_MISC_GEN
USE test_async_APIs

IMPLICIT NONE
Expand Down

0 comments on commit 5672fd8

Please sign in to comment.