@@ -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= R4 KIND))
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= R8 KIND))
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= R4 KIND))
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= R8 KIND))
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= R4 KIND))
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= R8 KIND))
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= R4 KIND))
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= R8 KIND))
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,R4 KIND)
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,R8 KIND)
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(:),R4 KIND)
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(:),R8 KIND)
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