Skip to content

Commit 7b75c62

Browse files
committed
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.
1 parent 2cc8060 commit 7b75c62

File tree

1 file changed

+167
-45
lines changed

1 file changed

+167
-45
lines changed

src/framework/mpas_io.F

+167-45
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,10 @@ module mpas_io
8484

8585
#ifdef MPAS_PIO_SUPPORT
8686
integer, private :: io_global_err = PIO_noerr
87+
interface put_att_pio
88+
module procedure put_att_0d_generic_pio
89+
module procedure put_att_1d_generic_pio
90+
end interface put_att_pio
8791
#endif
8892
#ifdef MPAS_SMIOL_SUPPORT
8993
integer, private :: io_global_err = SMIOL_SUCCESS
@@ -5033,6 +5037,149 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio
50335037

50345038
end subroutine MPAS_io_get_att_real1d
50355039

5040+
function handle_put_att_pio_redef(handle) result (pio_ierr)
5041+
implicit none
5042+
type(MPAS_IO_Handle_type), intent(inout) :: handle
5043+
integer :: pio_ierr
5044+
5045+
call mpas_log_write('Calling PIO_redef')
5046+
pio_ierr = PIO_redef(handle % pio_file)
5047+
if (pio_ierr /= PIO_noerr) then
5048+
io_global_err = pio_ierr
5049+
return
5050+
end if
5051+
call mpas_log_write('Successfully called PIO_redef')
5052+
5053+
end function handle_put_att_pio_redef
5054+
5055+
function handle_put_att_pio_enddef(handle) result (pio_ierr)
5056+
implicit none
5057+
type(MPAS_IO_Handle_type), intent(inout) :: handle
5058+
integer :: pio_ierr
5059+
5060+
call mpas_log_write('Calling PIO_enddef')
5061+
pio_ierr = PIO_enddef(handle % pio_file)
5062+
if (pio_ierr /= PIO_noerr) then
5063+
io_global_err = pio_ierr
5064+
return
5065+
end if
5066+
call mpas_log_write('Successfully called PIO_enddef')
5067+
5068+
end function handle_put_att_pio_enddef
5069+
5070+
function put_att_0d_generic_pio(handle, varid, attName, attValue, ierr) result(pio_ierr)
5071+
implicit none
5072+
type(MPAS_IO_Handle_type), intent(inout) :: handle
5073+
integer, intent(in) :: varid
5074+
character(len=*), intent(in) :: attName
5075+
class(*), intent(in) :: attValue
5076+
integer, optional :: ierr
5077+
integer :: pio_ierr
5078+
character(len=*), parameter :: log_message_prefix = 'Calling PIO_put_att for'
5079+
5080+
select type(attValue)
5081+
type is (integer)
5082+
call mpas_log_write(log_message_prefix//' integer attribute '//trim(attname))
5083+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5084+
type is (real(kind=R4KIND))
5085+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5086+
call mpas_log_write(log_message_prefix//' real(kind=R4KIND) attribute '//trim(attname))
5087+
type is (real(kind=R8KIND))
5088+
call mpas_log_write(log_message_prefix//' real(kind=R8KIND) attribute '//trim(attname))
5089+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5090+
type is (character(len=*))
5091+
call mpas_log_write(log_message_prefix//' text attribute '//trim(attname))
5092+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5093+
end select
5094+
5095+
if (pio_ierr /= PIO_noerr) then
5096+
io_global_err = pio_ierr
5097+
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
5098+
5099+
if (handle % preexisting_file .and. .not. handle % data_mode) then
5100+
if (handle_put_att_pio_redef(handle) /= PIO_noerr) return
5101+
5102+
select type(attValue)
5103+
type is (integer)
5104+
call mpas_log_write('Calling PIO_put_att for integer attribute '//trim(attname))
5105+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5106+
type is (real(kind=R4KIND))
5107+
call mpas_log_write('Calling PIO_put_att for real(kind=R4KIND) attribute '//trim(attname))
5108+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5109+
type is (real(kind=R8KIND))
5110+
call mpas_log_write('Calling PIO_put_att for real(kind=R8KIND) attribute '//trim(attname))
5111+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5112+
type is (character(len=*))
5113+
call mpas_log_write('Calling PIO_put_att for text attribute '//trim(attname))
5114+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5115+
end select
5116+
5117+
if (pio_ierr /= PIO_noerr) then
5118+
io_global_err = pio_ierr
5119+
return
5120+
end if
5121+
5122+
if (handle_put_att_pio_enddef(handle) /= PIO_noerr) return
5123+
5124+
if (present(ierr)) ierr = MPAS_IO_NOERR
5125+
end if
5126+
return
5127+
end if
5128+
end function put_att_0d_generic_pio
5129+
5130+
function put_att_1d_generic_pio(handle, varid, attName, attValue, ierr) result(pio_ierr)
5131+
implicit none
5132+
type(MPAS_IO_Handle_type), intent(inout) :: handle
5133+
integer, intent(in) :: varid
5134+
character(len=*), intent(in) :: attName
5135+
class(*), dimension(:), intent(in) :: attValue
5136+
integer, optional :: ierr
5137+
integer :: pio_ierr
5138+
character(len=*), parameter :: log_message_prefix = 'Calling PIO_put_att for'
5139+
5140+
select type(attValue)
5141+
type is (integer)
5142+
call mpas_log_write(log_message_prefix//' integer 1D-array attribute '//trim(attname))
5143+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5144+
type is (real(kind=R4KIND))
5145+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5146+
call mpas_log_write(log_message_prefix//' real(kind=R4KIND) 1D-array attribute '//trim(attname))
5147+
type is (real(kind=R8KIND))
5148+
call mpas_log_write(log_message_prefix//' real(kind=R8KIND) 1D-array attribute '//trim(attname))
5149+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5150+
end select
5151+
5152+
if (pio_ierr /= PIO_noerr) then
5153+
io_global_err = pio_ierr
5154+
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
5155+
5156+
if (handle % preexisting_file .and. .not. handle % data_mode) then
5157+
if (handle_put_att_pio_redef(handle) /= PIO_noerr) return
5158+
select type(attValue)
5159+
type is (integer)
5160+
call mpas_log_write('Calling PIO_put_att for integer 1D-array attribute '//trim(attname))
5161+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5162+
type is (real(kind=R4KIND))
5163+
call mpas_log_write('Calling PIO_put_att for real(kind=R4KIND) 1D-array attribute '//trim(attname))
5164+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5165+
type is (real(kind=R8KIND))
5166+
call mpas_log_write('Calling PIO_put_att for real(kind=R8KIND) 1D-array attribute '//trim(attname))
5167+
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
5168+
end select
5169+
5170+
if (pio_ierr /= PIO_noerr) then
5171+
io_global_err = pio_ierr
5172+
return
5173+
end if
5174+
5175+
if (handle_put_att_pio_enddef(handle) /= PIO_noerr) return
5176+
if (present(ierr)) ierr = MPAS_IO_NOERR
5177+
end if
5178+
return
5179+
end if
5180+
end function put_att_1d_generic_pio
5181+
5182+
50365183

50375184
subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr)
50385185

@@ -5338,7 +5485,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal,
53385485
end if
53395486

53405487
#ifdef MPAS_PIO_SUPPORT
5341-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal)
5488+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
53425489
if (pio_ierr /= PIO_noerr) then
53435490
io_global_err = pio_ierr
53445491
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
@@ -5523,7 +5670,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal,
55235670
end if
55245671

55255672
#ifdef MPAS_PIO_SUPPORT
5526-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal)
5673+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
55275674
if (pio_ierr /= PIO_noerr) then
55285675
io_global_err = pio_ierr
55295676
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
@@ -5689,7 +5836,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
56895836
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_SINGLE_PRECISION)) then
56905837
singleVal = real(attValueLocal,R4KIND)
56915838
#ifdef MPAS_PIO_SUPPORT
5692-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal)
5839+
pio_ierr = put_att_pio(handle, varid, attName, singleVal, ierr=ierr)
56935840
#endif
56945841

56955842
#ifdef MPAS_SMIOL_SUPPORT
@@ -5703,7 +5850,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
57035850
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then
57045851
doubleVal = real(attValueLocal,R8KIND)
57055852
#ifdef MPAS_PIO_SUPPORT
5706-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal)
5853+
pio_ierr = put_att_pio(handle, varid, attName, doubleVal, ierr=ierr)
57075854
#endif
57085855

57095856
#ifdef MPAS_SMIOL_SUPPORT
@@ -5715,7 +5862,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
57155862
#endif
57165863
else
57175864
#ifdef MPAS_PIO_SUPPORT
5718-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal)
5865+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
57195866
#endif
57205867

57215868
#ifdef MPAS_SMIOL_SUPPORT
@@ -5733,6 +5880,14 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
57335880
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
57345881
return
57355882
end if
5883+
5884+
! if (handle % preexisting_file) then
5885+
! pio_ierr = PIO_enddef(handle % pio_file)
5886+
! if (pio_ierr /= PIO_noerr) then
5887+
! io_global_err = pio_ierr
5888+
! return
5889+
! end if
5890+
! end if
57365891
#endif
57375892
#ifdef MPAS_SMIOL_SUPPORT
57385893
if (local_ierr /= SMIOL_SUCCESS) then
@@ -5919,20 +6074,20 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal,
59196074
allocate(singleVal(size(attValueLocal)))
59206075
singleVal(:) = real(attValueLocal(:),R4KIND)
59216076
#ifdef MPAS_PIO_SUPPORT
5922-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal)
6077+
pio_ierr = put_att_pio(handle, varid, attName, singleVal, ierr=ierr)
59236078
#endif
59246079
deallocate(singleVal)
59256080
else if ((new_attlist_node % attHandle % precision == MPAS_IO_DOUBLE_PRECISION) .and. &
59266081
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then
59276082
allocate(doubleVal(size(attValueLocal)))
59286083
doubleVal(:) = real(attValueLocal(:),R8KIND)
59296084
#ifdef MPAS_PIO_SUPPORT
5930-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal)
6085+
pio_ierr = put_att_pio(handle, varid, attName, doubleVal, ierr=ierr)
59316086
#endif
59326087
deallocate(doubleVal)
59336088
else
59346089
#ifdef MPAS_PIO_SUPPORT
5935-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal)
6090+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
59366091
#endif
59376092
end if
59386093
#ifdef MPAS_PIO_SUPPORT
@@ -5950,6 +6105,9 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal,
59506105
end subroutine MPAS_io_put_att_real1d
59516106

59526107

6108+
6109+
6110+
59536111
subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, ierr)
59546112

59556113
implicit none
@@ -6100,43 +6258,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i
61006258
end if
61016259

61026260
#ifdef MPAS_PIO_SUPPORT
6103-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal))
6104-
if (pio_ierr /= PIO_noerr) then
6105-
6106-
io_global_err = pio_ierr
6107-
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
6108-
6109-
!
6110-
! If we are working with a pre-existing file and the text attribute is larger than in the file, we need
6111-
! to enter define mode before writing the attribute. Note the PIO_redef documentation:
6112-
! 'Entering and leaving netcdf define mode causes a file sync operation to occur,
6113-
! these operations can be very expensive in parallel systems.'
6114-
!
6115-
if (handle % preexisting_file .and. .not. handle % data_mode) then
6116-
pio_ierr = PIO_redef(handle % pio_file)
6117-
if (pio_ierr /= PIO_noerr) then
6118-
io_global_err = pio_ierr
6119-
return
6120-
end if
6121-
6122-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, trim(attValueLocal))
6123-
if (pio_ierr /= PIO_noerr) then
6124-
io_global_err = pio_ierr
6125-
return
6126-
end if
6127-
6128-
pio_ierr = PIO_enddef(handle % pio_file)
6129-
if (pio_ierr /= PIO_noerr) then
6130-
io_global_err = pio_ierr
6131-
return
6132-
end if
6133-
6134-
if (present(ierr)) ierr = MPAS_IO_NOERR
6135-
6136-
end if
6137-
6138-
return
6139-
end if
6261+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
61406262
#endif
61416263

61426264
#ifdef MPAS_SMIOL_SUPPORT

0 commit comments

Comments
 (0)