Skip to content

Commit 228b58c

Browse files
amstokelyamstokely
committed
Updated put_att_pio generic interface to handle scalar and 1D array attributes.
1 parent db67cf3 commit 228b58c

File tree

1 file changed

+156
-108
lines changed

1 file changed

+156
-108
lines changed

‎src/framework/mpas_io.F

+156-108
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
@@ -105,10 +109,6 @@ module mpas_io
105109
module procedure MPAS_io_get_var_char1d
106110
end interface MPAS_io_get_var
107111

108-
interface put_att_pio
109-
module procedure put_att_generic_pio
110-
end interface put_att_pio
111-
112112
interface MPAS_io_put_var
113113
module procedure MPAS_io_put_var_int0d
114114
module procedure MPAS_io_put_var_int1d
@@ -5037,6 +5037,149 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio
50375037

50385038
end subroutine MPAS_io_get_att_real1d
50395039

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+
50405183

50415184
subroutine MPAS_io_get_att_text(handle, attName, attValue, fieldname, ierr)
50425185

@@ -5342,29 +5485,12 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal,
53425485
end if
53435486

53445487
#ifdef MPAS_PIO_SUPPORT
5345-
! if (handle % preexisting_file) then
5346-
! pio_ierr = PIO_redef(handle % pio_file)
5347-
! if (pio_ierr /= PIO_noerr) then
5348-
! io_global_err = pio_ierr
5349-
! return
5350-
! end if
5351-
! end if
5352-
5353-
call put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
5354-
!pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal)
5488+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
53555489
if (pio_ierr /= PIO_noerr) then
53565490
io_global_err = pio_ierr
53575491
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
53585492
return
53595493
end if
5360-
5361-
! if (handle % preexisting_file) then
5362-
! pio_ierr = PIO_enddef(handle % pio_file)
5363-
! if (pio_ierr /= PIO_noerr) then
5364-
! io_global_err = pio_ierr
5365-
! return
5366-
! end if
5367-
! end if
53685494
#endif
53695495

53705496
#ifdef MPAS_SMIOL_SUPPORT
@@ -5544,7 +5670,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal,
55445670
end if
55455671

55465672
#ifdef MPAS_PIO_SUPPORT
5547-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal)
5673+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
55485674
if (pio_ierr /= PIO_noerr) then
55495675
io_global_err = pio_ierr
55505676
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
@@ -5706,22 +5832,11 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
57065832
end if
57075833
end if
57085834

5709-
#ifdef MPAS_PIO_SUPPORT
5710-
! if (handle % preexisting_file) then
5711-
! pio_ierr = PIO_redef(handle % pio_file)
5712-
! if (pio_ierr /= PIO_noerr) then
5713-
! io_global_err = pio_ierr
5714-
! return
5715-
! end if
5716-
! end if
5717-
#endif
5718-
57195835
if ((new_attlist_node % attHandle % precision == MPAS_IO_SINGLE_PRECISION) .and. &
57205836
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_SINGLE_PRECISION)) then
57215837
singleVal = real(attValueLocal,R4KIND)
57225838
#ifdef MPAS_PIO_SUPPORT
5723-
call put_att_pio(handle, varid, attName, singleVal, ierr=ierr)
5724-
!pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal)
5839+
pio_ierr = put_att_pio(handle, varid, attName, singleVal, ierr=ierr)
57255840
#endif
57265841

57275842
#ifdef MPAS_SMIOL_SUPPORT
@@ -5735,8 +5850,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
57355850
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then
57365851
doubleVal = real(attValueLocal,R8KIND)
57375852
#ifdef MPAS_PIO_SUPPORT
5738-
call put_att_pio(handle, varid, attName, doubleVal, ierr=ierr)
5739-
!pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal)
5853+
pio_ierr = put_att_pio(handle, varid, attName, doubleVal, ierr=ierr)
57405854
#endif
57415855

57425856
#ifdef MPAS_SMIOL_SUPPORT
@@ -5748,8 +5862,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
57485862
#endif
57495863
else
57505864
#ifdef MPAS_PIO_SUPPORT
5751-
call put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
5752-
!pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal)
5865+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
57535866
#endif
57545867

57555868
#ifdef MPAS_SMIOL_SUPPORT
@@ -5961,20 +6074,20 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal,
59616074
allocate(singleVal(size(attValueLocal)))
59626075
singleVal(:) = real(attValueLocal(:),R4KIND)
59636076
#ifdef MPAS_PIO_SUPPORT
5964-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, singleVal)
6077+
pio_ierr = put_att_pio(handle, varid, attName, singleVal, ierr=ierr)
59656078
#endif
59666079
deallocate(singleVal)
59676080
else if ((new_attlist_node % attHandle % precision == MPAS_IO_DOUBLE_PRECISION) .and. &
59686081
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then
59696082
allocate(doubleVal(size(attValueLocal)))
59706083
doubleVal(:) = real(attValueLocal(:),R8KIND)
59716084
#ifdef MPAS_PIO_SUPPORT
5972-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, doubleVal)
6085+
pio_ierr = put_att_pio(handle, varid, attName, doubleVal, ierr=ierr)
59736086
#endif
59746087
deallocate(doubleVal)
59756088
else
59766089
#ifdef MPAS_PIO_SUPPORT
5977-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValueLocal)
6090+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
59786091
#endif
59796092
end if
59806093
#ifdef MPAS_PIO_SUPPORT
@@ -5991,72 +6104,7 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal,
59916104

59926105
end subroutine MPAS_io_put_att_real1d
59936106

5994-
subroutine put_att_generic_pio(handle, varid, attName, attValue, ierr)
5995-
type (MPAS_IO_Handle_type), intent(inout) :: handle
5996-
integer, intent(in) :: varid
5997-
character (len=*), intent(in) :: attName
5998-
class(*), intent(in) :: attValue
5999-
integer, optional :: ierr
6000-
6001-
select type(attValue)
6002-
type is (integer)
6003-
call mpas_log_write('Calling PIO_put_att for integer attribute '//trim(attname))
6004-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
6005-
type is (real(kind=R4KIND))
6006-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
6007-
call mpas_log_write('Calling PIO_put_att for real(kind=R4KIND attribute '//trim(attname))
6008-
type is (real(kind=R8KIND))
6009-
call mpas_log_write('Calling PIO_put_att for real(kind=R8KIND attribute '//trim(attname))
6010-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
6011-
type is (character(len=*))
6012-
call mpas_log_write('Calling PIO_put_att for text attribute '//trim(attname))
6013-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
6014-
end select
6015-
if (pio_ierr /= PIO_noerr) then
60166107

6017-
io_global_err = pio_ierr
6018-
if (present(ierr)) ierr = MPAS_IO_ERR_BACKEND
6019-
6020-
if (handle % preexisting_file .and. .not. handle % data_mode) then
6021-
call mpas_log_write('Calling PIO_redef')
6022-
pio_ierr = PIO_redef(handle % pio_file)
6023-
if (pio_ierr /= PIO_noerr) then
6024-
io_global_err = pio_ierr
6025-
return
6026-
end if
6027-
call mpas_log_write('Successfully called PIO_redef')
6028-
select type(attValue)
6029-
type is (integer)
6030-
call mpas_log_write('Calling PIO_put_att for integer attribute '//trim(attname))
6031-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
6032-
type is (real(kind=R4KIND))
6033-
call mpas_log_write('Calling PIO_put_att for real(kind=R4KIND attribute '//trim(attname))
6034-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
6035-
type is (real(kind=R8KIND))
6036-
call mpas_log_write('Calling PIO_put_att for real(kind=R8KIND attribute '//trim(attname))
6037-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
6038-
type is (character(len=*))
6039-
call mpas_log_write('Calling PIO_put_att for text attribute '//trim(attname))
6040-
pio_ierr = PIO_put_att(handle % pio_file, varid, attName, attValue)
6041-
end select
6042-
if (pio_ierr /= PIO_noerr) then
6043-
io_global_err = pio_ierr
6044-
return
6045-
end if
6046-
6047-
call mpas_log_write('Calling PIO_enddef')
6048-
pio_ierr = PIO_enddef(handle % pio_file)
6049-
if (pio_ierr /= PIO_noerr) then
6050-
io_global_err = pio_ierr
6051-
return
6052-
end if
6053-
call mpas_log_write('Successfully called PIO_enddef')
6054-
6055-
if (present(ierr)) ierr = MPAS_IO_NOERR
6056-
end if
6057-
return
6058-
end if
6059-
end subroutine
60606108

60616109

60626110

@@ -6210,7 +6258,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i
62106258
end if
62116259

62126260
#ifdef MPAS_PIO_SUPPORT
6213-
call put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
6261+
pio_ierr = put_att_pio(handle, varid, attName, attValueLocal, ierr=ierr)
62146262
#endif
62156263

62166264
#ifdef MPAS_SMIOL_SUPPORT

0 commit comments

Comments
 (0)