@@ -84,6 +84,10 @@ module mpas_io
84
84
85
85
#ifdef MPAS_PIO_SUPPORT
86
86
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
87
91
#endif
88
92
#ifdef MPAS_SMIOL_SUPPORT
89
93
integer , private :: io_global_err = SMIOL_SUCCESS
@@ -5033,6 +5037,149 @@ subroutine MPAS_io_get_att_real1d(handle, attName, attValue, fieldname, precisio
5033
5037
5034
5038
end subroutine MPAS_io_get_att_real1d
5035
5039
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
+
5036
5183
5037
5184
subroutine MPAS_io_get_att_text (handle , attName , attValue , fieldname , ierr )
5038
5185
@@ -5338,7 +5485,7 @@ subroutine MPAS_io_put_att_int0d(handle, attName, attValue, fieldname, syncVal,
5338
5485
end if
5339
5486
5340
5487
#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)
5342
5489
if (pio_ierr /= PIO_noerr) then
5343
5490
io_global_err = pio_ierr
5344
5491
if (present (ierr)) ierr = MPAS_IO_ERR_BACKEND
@@ -5523,7 +5670,7 @@ subroutine MPAS_io_put_att_int1d(handle, attName, attValue, fieldname, syncVal,
5523
5670
end if
5524
5671
5525
5672
#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)
5527
5674
if (pio_ierr /= PIO_noerr) then
5528
5675
io_global_err = pio_ierr
5529
5676
if (present (ierr)) ierr = MPAS_IO_ERR_BACKEND
@@ -5689,7 +5836,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
5689
5836
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_SINGLE_PRECISION)) then
5690
5837
singleVal = real (attValueLocal,R4 KIND)
5691
5838
#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)
5693
5840
#endif
5694
5841
5695
5842
#ifdef MPAS_SMIOL_SUPPORT
@@ -5703,7 +5850,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
5703
5850
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then
5704
5851
doubleVal = real (attValueLocal,R8 KIND)
5705
5852
#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)
5707
5854
#endif
5708
5855
5709
5856
#ifdef MPAS_SMIOL_SUPPORT
@@ -5715,7 +5862,7 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
5715
5862
#endif
5716
5863
else
5717
5864
#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)
5719
5866
#endif
5720
5867
5721
5868
#ifdef MPAS_SMIOL_SUPPORT
@@ -5733,6 +5880,14 @@ subroutine MPAS_io_put_att_real0d(handle, attName, attValue, fieldname, syncVal,
5733
5880
if (present (ierr)) ierr = MPAS_IO_ERR_BACKEND
5734
5881
return
5735
5882
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
5736
5891
#endif
5737
5892
#ifdef MPAS_SMIOL_SUPPORT
5738
5893
if (local_ierr /= SMIOL_SUCCESS) then
@@ -5919,20 +6074,20 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal,
5919
6074
allocate(singleVal(size (attValueLocal)))
5920
6075
singleVal(:) = real (attValueLocal(:),R4 KIND)
5921
6076
#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)
5923
6078
#endif
5924
6079
deallocate(singleVal)
5925
6080
else if ((new_attlist_node % attHandle % precision == MPAS_IO_DOUBLE_PRECISION) .and. &
5926
6081
(MPAS_IO_NATIVE_PRECISION /= MPAS_IO_DOUBLE_PRECISION)) then
5927
6082
allocate(doubleVal(size (attValueLocal)))
5928
6083
doubleVal(:) = real (attValueLocal(:),R8 KIND)
5929
6084
#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)
5931
6086
#endif
5932
6087
deallocate(doubleVal)
5933
6088
else
5934
6089
#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)
5936
6091
#endif
5937
6092
end if
5938
6093
#ifdef MPAS_PIO_SUPPORT
@@ -5950,6 +6105,9 @@ subroutine MPAS_io_put_att_real1d(handle, attName, attValue, fieldname, syncVal,
5950
6105
end subroutine MPAS_io_put_att_real1d
5951
6106
5952
6107
6108
+
6109
+
6110
+
5953
6111
subroutine MPAS_io_put_att_text (handle , attName , attValue , fieldname , syncVal , ierr )
5954
6112
5955
6113
implicit none
@@ -6100,43 +6258,7 @@ subroutine MPAS_io_put_att_text(handle, attName, attValue, fieldname, syncVal, i
6100
6258
end if
6101
6259
6102
6260
#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)
6140
6262
#endif
6141
6263
6142
6264
#ifdef MPAS_SMIOL_SUPPORT
0 commit comments