Skip to content

Commit

Permalink
fixed warnings in pio_decomp_fillval.F90
Browse files Browse the repository at this point in the history
  • Loading branch information
edhartnett committed Jun 25, 2019
1 parent 860807c commit 85c7a4c
Showing 1 changed file with 4 additions and 7 deletions.
11 changes: 4 additions & 7 deletions tests/general/pio_iosystem_tests.F90.in
Original file line number Diff line number Diff line change
Expand Up @@ -97,13 +97,11 @@ END SUBROUTINE create_file
! Check the contents of file : Check the
! global attribute 'filename' (should be equal to the
! name of the file, fname)
SUBROUTINE check_file(comm, iosys, iotype, pio_file, fname, attname, dimname, ret)
SUBROUTINE check_file(comm, pio_file, fname, attname, dimname, ret)
use pio_tutil
implicit none

integer, intent(in) :: comm
type(iosystem_desc_t), intent(inout) :: iosys
integer, intent(in) :: iotype
type(file_desc_t), intent(inout) :: pio_file
character(len=*), intent(in) :: fname
character(len=*), intent(in) :: attname
Expand Down Expand Up @@ -148,7 +146,7 @@ SUBROUTINE open_and_check_file(comm, iosys, iotype, pio_file, fname, &
ret = PIO_openfile(iosys, pio_file, iotype, fname, PIO_write)
PIO_TF_CHECK_ERR(ret, comm, "Failed to open:" // fname)

call check_file(comm, iosys, iotype, pio_file, fname, attname, dimname, ret)
call check_file(comm, pio_file, fname, attname, dimname, ret)
PIO_TF_CHECK_ERR(ret, comm, "Checking contents of file failed:" // fname)

if(.not. disable_fclose) then
Expand Down Expand Up @@ -227,7 +225,6 @@ PIO_TF_AUTO_TEST_SUB_BEGIN two_iosystems_even_all
character(len=PIO_TF_MAX_STR_LEN), target :: fname2 = "pio_iosys_test_file2.nc"
character(len=PIO_TF_MAX_STR_LEN), parameter :: attname = "filename"
character(len=PIO_TF_MAX_STR_LEN), parameter :: dimname = "filename_dim"
character(len=PIO_TF_MAX_STR_LEN), pointer :: fname
integer, dimension(:), allocatable :: iotypes
character(len=PIO_TF_MAX_STR_LEN), dimension(:), allocatable :: iotype_descs
integer :: i, num_iotypes = 0
Expand Down Expand Up @@ -280,13 +277,13 @@ PIO_TF_AUTO_TEST_SUB_BEGIN two_iosystems_even_all
! Check contents of the files again
! - PIO called from odd and even processes separately with odd_even_iosys
if(is_even) then
call check_file(odd_even_comm, odd_even_iosys, iotypes(i), pio_file1, &
call check_file(odd_even_comm, pio_file1, &
fname1, attname, dimname, ret)
!call PIO_closefile(pio_file1)
end if
PIO_TF_CHECK_ERR(ret, "Checking contents of file failed :" // fname1)

call check_file(pio_tf_comm_, pio_tf_iosystem_, iotypes(i), pio_file2, &
call check_file(pio_tf_comm_, pio_file2, &
fname2, attname, dimname, ret)
PIO_TF_CHECK_ERR(ret, "Checking contents of file failed :" // fname2)

Expand Down

0 comments on commit 85c7a4c

Please sign in to comment.