From c066590a2da615c15bdda2a3987f6bd853417846 Mon Sep 17 00:00:00 2001 From: amstokely Date: Mon, 9 Sep 2024 09:59:39 -0600 Subject: [PATCH 1/5] Implement try-fail method to write new attributes to NetCDF files in PIO - Adds support for adding new attributes to existing NetCDF files by minimizing expensive mode switches between data and define modes. - Introduces `put_att_pio` interface with try-fail logic, handling scalar and 1D attributes of various data types (int, real, double, string). - Enhances performance by avoiding unnecessary transitions and includes extensive logging for better traceability. - Ensures backward compatibility for NetCDF files generated by earlier MPAS versions. --- src/framework/mpas_io.F | 212 +++++++++++++++++++++++++++++++--------- 1 file changed, 167 insertions(+), 45 deletions(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index a9ddee472c..c3c28b27c2 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -84,6 +84,10 @@ module mpas_io #ifdef MPAS_PIO_SUPPORT integer, private :: io_global_err = PIO_noerr + interface put_att_pio + module procedure put_att_0d_generic_pio + module procedure put_att_1d_generic_pio + end interface put_att_pio #endif #ifdef MPAS_SMIOL_SUPPORT integer, private :: io_global_err = SMIOL_SUCCESS @@ -5033,6 +5037,149 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio end subroutine MPAS_io_get_att_real1d + function handle_put_att_pio_redef(handle) result (pio_ierr) + implicit none + type(MPAS_IO_Handle_type), intent(inout) :: handle + integer :: pio_ierr + + call mpas_log_write('Calling PIO_redef') + pio_ierr = PIO_redef(handle % pio_file) + if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr + return + end if + call mpas_log_write('Successfully called PIO_redef') + + end function handle_put_att_pio_redef + + function handle_put_att_pio_enddef(handle) result (pio_ierr) + implicit none + type(MPAS_IO_Handle_type), intent(inout) :: handle + integer :: pio_ierr + + call mpas_log_write('Calling PIO_enddef') + pio_ierr = PIO_enddef(handle % pio_file) + if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr + return + end if + call mpas_log_write('Successfully called PIO_enddef') + + end function handle_put_att_pio_enddef + + function put_att_0d_generic_pio(handle, varid, attName, attValue, ierr) result(pio_ierr) + implicit none + type(MPAS_IO_Handle_type), intent(inout) :: handle + integer, intent(in) :: varid + character(len=*), intent(in) :: attName + class(*), intent(in) :: attValue + integer, optional :: ierr + integer :: pio_ierr + character(len=*), parameter :: log_message_prefix = 'Calling PIO_put_att for' + + select type(attValue) + type is (integer) + call mpas_log_write(log_message_prefix//' integer attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + type is (real(kind=R4KIND)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + call mpas_log_write(log_message_prefix//' real(kind=R4KIND) attribute '//trim(attname)) + type is (real(kind=R8KIND)) + call mpas_log_write(log_message_prefix//' real(kind=R8KIND) attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + type is (character(len=*)) + call mpas_log_write(log_message_prefix//' text attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + end select + + if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + + if (handle % preexisting_file .and. .not. handle % data_mode) then + if (handle_put_att_pio_redef(handle) /= PIO_noerr) return + + select type(attValue) + type is (integer) + call mpas_log_write('Calling PIO_put_att for integer attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + type is (real(kind=R4KIND)) + call mpas_log_write('Calling PIO_put_att for real(kind=R4KIND) attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + type is (real(kind=R8KIND)) + call mpas_log_write('Calling PIO_put_att for real(kind=R8KIND) attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + type is (character(len=*)) + call mpas_log_write('Calling PIO_put_att for text attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + end select + + if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr + return + end if + + if (handle_put_att_pio_enddef(handle) /= PIO_noerr) return + + if (present(ierr)) ierr = MPAS_IO_NOERR + end if + return + end if + end function put_att_0d_generic_pio + + function put_att_1d_generic_pio(handle, varid, attName, attValue, ierr) result(pio_ierr) + implicit none + type(MPAS_IO_Handle_type), intent(inout) :: handle + integer, intent(in) :: varid + character(len=*), intent(in) :: attName + class(*), dimension(:), intent(in) :: attValue + integer, optional :: ierr + integer :: pio_ierr + character(len=*), parameter :: log_message_prefix = 'Calling PIO_put_att for' + + select type(attValue) + type is (integer) + call mpas_log_write(log_message_prefix//' integer 1D-array attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + type is (real(kind=R4KIND)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + call mpas_log_write(log_message_prefix//' real(kind=R4KIND) 1D-array attribute '//trim(attname)) + type is (real(kind=R8KIND)) + call mpas_log_write(log_message_prefix//' real(kind=R8KIND) 1D-array attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + end select + + if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr + if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND + + if (handle % preexisting_file .and. .not. handle % data_mode) then + if (handle_put_att_pio_redef(handle) /= PIO_noerr) return + select type(attValue) + type is (integer) + call mpas_log_write('Calling PIO_put_att for integer 1D-array attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + type is (real(kind=R4KIND)) + call mpas_log_write('Calling PIO_put_att for real(kind=R4KIND) 1D-array attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + type is (real(kind=R8KIND)) + call mpas_log_write('Calling PIO_put_att for real(kind=R8KIND) 1D-array attribute '//trim(attname)) + pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) + end select + + if (pio_ierr /= PIO_noerr) then + io_global_err = pio_ierr + return + end if + + if (handle_put_att_pio_enddef(handle) /= PIO_noerr) return + if (present(ierr)) ierr = MPAS_IO_NOERR + end if + return + end if + end function put_att_1d_generic_pio + + subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) @@ -5338,7 +5485,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal, end if #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) + pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr) if (pio_ierr /= PIO_noerr) then io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND @@ -5523,7 +5670,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal, end if #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) + pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr) if (pio_ierr /= PIO_noerr) then io_global_err = pio_ierr if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND @@ -5689,7 +5836,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, (MPAS_IO_NATIVE_PRECISION /= MPAS_IO_SINGLE_PRECISION)) then singleVal = real(attValueLocal,R4KIND) #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal) + pio_ierr = put_att_pio(handle, varid, attName, singleVal, ierr=ierr) #endif #ifdef MPAS_SMIOL_SUPPORT @@ -5703,7 +5850,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, (MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then doubleVal = real(attValueLocal,R8KIND) #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal) + pio_ierr = put_att_pio(handle, varid, attName, doubleVal, ierr=ierr) #endif #ifdef MPAS_SMIOL_SUPPORT @@ -5715,7 +5862,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, #endif else #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) + pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr) #endif #ifdef MPAS_SMIOL_SUPPORT @@ -5733,6 +5880,14 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if + +! if (handle % preexisting_file) then +! pio_ierr = PIO_enddef(handle % pio_file) +! if (pio_ierr /= PIO_noerr) then +! io_global_err = pio_ierr +! return +! end if +! end if #endif #ifdef MPAS_SMIOL_SUPPORT if (local_ierr /= SMIOL_SUCCESS) then @@ -5919,7 +6074,7 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, allocate(singleVal(size(attValueLocal))) singleVal(:) = real(attValueLocal(:),R4KIND) #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal) + pio_ierr = put_att_pio(handle, varid, attName, singleVal, ierr=ierr) #endif deallocate(singleVal) else if ((new_attlist_node % attHandle % precision == MPAS_IO_DOUBLE_PRECISION) .and. & @@ -5927,12 +6082,12 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, allocate(doubleVal(size(attValueLocal))) doubleVal(:) = real(attValueLocal(:),R8KIND) #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal) + pio_ierr = put_att_pio(handle, varid, attName, doubleVal, ierr=ierr) #endif deallocate(doubleVal) else #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal) + pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr) #endif end if #ifdef MPAS_PIO_SUPPORT @@ -5950,6 +6105,9 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal, end subroutine MPAS_io_put_att_real1d + + + subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, ierr) implicit none @@ -6100,43 +6258,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i end if #ifdef MPAS_PIO_SUPPORT - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) - if (pio_ierr /= PIO_noerr) then - - io_global_err = pio_ierr - if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND - - ! - ! If we are working with a pre-existing file and the text attribute is larger than in the file, we need - ! to enter define mode before writing the attribute. Note the PIO_redef documentation: - ! 'Entering and leaving netcdf define mode causes a file sync operation to occur, - ! these operations can be very expensive in parallel systems.' - ! - if (handle % preexisting_file .and. .not. handle % data_mode) then - pio_ierr = PIO_redef(handle % pio_file) - if (pio_ierr /= PIO_noerr) then - io_global_err = pio_ierr - return - end if - - pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal)) - if (pio_ierr /= PIO_noerr) then - io_global_err = pio_ierr - return - end if - - pio_ierr = PIO_enddef(handle % pio_file) - if (pio_ierr /= PIO_noerr) then - io_global_err = pio_ierr - return - end if - - if (present(ierr)) ierr = MPAS_IO_NOERR - - end if - - return - end if + pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr) #endif #ifdef MPAS_SMIOL_SUPPORT From d03136a3bb82818cdc8cb98ac42077bde3a06e64 Mon Sep 17 00:00:00 2001 From: amstokely Date: Thu, 5 Dec 2024 14:38:41 -0700 Subject: [PATCH 2/5] Removed incorrect data mode/preexisting file logic in mpas_io.F --- src/framework/mpas_io.F | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index c3c28b27c2..01458d2cec 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -5042,13 +5042,11 @@ function handle_put_att_pio_redef(handle) result (pio_ierr) type(MPAS_IO_Handle_type), intent(inout) :: handle integer :: pio_ierr - call mpas_log_write('Calling PIO_redef') pio_ierr = PIO_redef(handle % pio_file) if (pio_ierr /= PIO_noerr) then io_global_err = pio_ierr return end if - call mpas_log_write('Successfully called PIO_redef') end function handle_put_att_pio_redef @@ -5057,13 +5055,11 @@ function handle_put_att_pio_enddef(handle) result (pio_ierr) type(MPAS_IO_Handle_type), intent(inout) :: handle integer :: pio_ierr - call mpas_log_write('Calling PIO_enddef') pio_ierr = PIO_enddef(handle % pio_file) if (pio_ierr /= PIO_noerr) then io_global_err = pio_ierr return end if - call mpas_log_write('Successfully called PIO_enddef') end function handle_put_att_pio_enddef @@ -5075,20 +5071,15 @@ function put_att_0d_generic_pio(handle, varid, attName, attValue, ierr) result(p class(*), intent(in) :: attValue integer, optional :: ierr integer :: pio_ierr - character(len=*), parameter :: log_message_prefix = 'Calling PIO_put_att for' select type(attValue) type is (integer) - call mpas_log_write(log_message_prefix//' integer attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) type is (real(kind=R4KIND)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) - call mpas_log_write(log_message_prefix//' real(kind=R4KIND) attribute '//trim(attname)) type is (real(kind=R8KIND)) - call mpas_log_write(log_message_prefix//' real(kind=R8KIND) attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) type is (character(len=*)) - call mpas_log_write(log_message_prefix//' text attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) end select @@ -5101,16 +5092,12 @@ function put_att_0d_generic_pio(handle, varid, attName, attValue, ierr) result(p select type(attValue) type is (integer) - call mpas_log_write('Calling PIO_put_att for integer attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) type is (real(kind=R4KIND)) - call mpas_log_write('Calling PIO_put_att for real(kind=R4KIND) attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) type is (real(kind=R8KIND)) - call mpas_log_write('Calling PIO_put_att for real(kind=R8KIND) attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) type is (character(len=*)) - call mpas_log_write('Calling PIO_put_att for text attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) end select @@ -5135,17 +5122,13 @@ function put_att_1d_generic_pio(handle, varid, attName, attValue, ierr) result(p class(*), dimension(:), intent(in) :: attValue integer, optional :: ierr integer :: pio_ierr - character(len=*), parameter :: log_message_prefix = 'Calling PIO_put_att for' select type(attValue) type is (integer) - call mpas_log_write(log_message_prefix//' integer 1D-array attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) type is (real(kind=R4KIND)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) - call mpas_log_write(log_message_prefix//' real(kind=R4KIND) 1D-array attribute '//trim(attname)) type is (real(kind=R8KIND)) - call mpas_log_write(log_message_prefix//' real(kind=R8KIND) 1D-array attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) end select @@ -5157,13 +5140,10 @@ function put_att_1d_generic_pio(handle, varid, attName, attValue, ierr) result(p if (handle_put_att_pio_redef(handle) /= PIO_noerr) return select type(attValue) type is (integer) - call mpas_log_write('Calling PIO_put_att for integer 1D-array attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) type is (real(kind=R4KIND)) - call mpas_log_write('Calling PIO_put_att for real(kind=R4KIND) 1D-array attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) type is (real(kind=R8KIND)) - call mpas_log_write('Calling PIO_put_att for real(kind=R8KIND) 1D-array attribute '//trim(attname)) pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue) end select From d5744e22d0803f547595097e612429bec7345671 Mon Sep 17 00:00:00 2001 From: amstokely Date: Fri, 6 Dec 2024 09:16:34 -0700 Subject: [PATCH 3/5] Removed commented out code block in mpas_io.F. --- src/framework/mpas_io.F | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index 01458d2cec..c4626f8d43 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -5861,14 +5861,6 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, return end if -! if (handle % preexisting_file) then -! pio_ierr = PIO_enddef(handle % pio_file) -! if (pio_ierr /= PIO_noerr) then -! io_global_err = pio_ierr -! return -! end if -! end if -#endif #ifdef MPAS_SMIOL_SUPPORT if (local_ierr /= SMIOL_SUCCESS) then call mpas_log_write('SMIOLf_define_att failed with error $i', intArgs=[local_ierr], messageType=MPAS_LOG_ERR) From ce3c4606c0fd50a81b955431d42e8d0efbd4d775 Mon Sep 17 00:00:00 2001 From: amstokely Date: Fri, 6 Dec 2024 09:22:19 -0700 Subject: [PATCH 4/5] Wrapped new pio subroutine defs in MPAS_PIO_SUPPORT preprocessing directive. --- src/framework/mpas_io.F | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index c4626f8d43..f44037c7c5 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -5037,6 +5037,8 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio end subroutine MPAS_io_get_att_real1d +#ifdef MPAS_PIO_SUPPORT + function handle_put_att_pio_redef(handle) result (pio_ierr) implicit none type(MPAS_IO_Handle_type), intent(inout) :: handle @@ -5158,7 +5160,7 @@ function put_att_1d_generic_pio(handle, varid, attName, attValue, ierr) result(p return end if end function put_att_1d_generic_pio - +#endif subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr) From dbc393313fc258ae773f20a4dc7aa3e8be782a7a Mon Sep 17 00:00:00 2001 From: amstokely Date: Fri, 6 Dec 2024 14:16:15 -0700 Subject: [PATCH 5/5] Fixed unterminated #ifdef MPAS_PIO_SUPPORT --- src/framework/mpas_io.F | 1 + 1 file changed, 1 insertion(+) diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index f44037c7c5..34fbcbc9d8 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -5862,6 +5862,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal, if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND return end if +#endif #ifdef MPAS_SMIOL_SUPPORT if (local_ierr /= SMIOL_SUCCESS) then