Skip to content

Commit

Permalink
Add mpas_modify_att() subroutines to mpas_attlist
Browse files Browse the repository at this point in the history 
CF compliance requires certain attributes to be updated periodically throughout
a run. The current attlist module only supports creation and retrieval of
attributes. This commit addds this functionality, and some basic tests. A couple
of modifications were also required in the test core to pass the correct iErr
variable, as the field tests were erroneously signaling failures. Changes were
also required to initialize "threadErrs". Noteably, this has the potential to
cause issues if there are changes to allow threads other than thread 0 to
modify the threadErrs array- if that change does occur, threadErrs should be
initialized from outside the omp parallel directive surrouding test_attlist
in mpas_test_core. Some superfluous whitespace was also reformatted.

It is also noted that these procedures are not currently threadsafe. Future
work may include threadsafe attribute modification and a more comprehensive
test suite for all of the attlist procedures.
  • Loading branch information
Matthew Dimond committed Jun 30, 2023
1 parent bddcbe4 commit 41b2bef
Show file tree
Hide file tree
Showing 2 changed files with 268 additions and 8 deletions.
57 changes: 53 additions & 4 deletions src/core_test/mpas_test_core_field_tests.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,19 +82,22 @@ subroutine test_core_attribute_list_test(domain, threadErrs, ierr)!{{{
integer, intent(out) :: ierr

type ( att_list_type ), pointer :: srcList, destList
integer :: srcInt, destInt
integer, dimension(:), pointer :: srcIntA, destIntA
real (kind=RKIND) :: srcReal, destReal
integer :: srcInt, destInt, modifyInt
integer, dimension(:), pointer :: srcIntA, destIntA, modifyIntA
real (kind=RKIND) :: srcReal, destReal, modifyReal
real (kind=RKIND), dimension(:), pointer :: srcRealA, destRealA
character (len=StrKIND) :: srcText, destText
real (kind=RKIND), dimension(:), pointer :: modifyRealA
character (len=StrKIND) :: srcText, destText, modifyText

integer :: threadNum

iErr = 0
threadErrs = 0

threadNum = mpas_threading_get_thread_num()

if ( threadNum == 0 ) then
threadNum = 1
allocate(srcList)
nullify(destList)

Expand Down Expand Up @@ -153,6 +156,52 @@ subroutine test_core_attribute_list_test(domain, threadErrs, ierr)!{{{
call mpas_log_write(' Duplicate string does not match', MPAS_LOG_ERR)
end if

allocate(modifyIntA(3))
allocate(modifyRealA(5))

modifyInt = 2
modifyIntA(:) = 2
modifyReal = 2.0_RKIND
modifyRealA(:) = 2.0_RKIND
modifyText = 'Modified'

call mpas_modify_att(srcList, 'testInt', modifyInt)
call mpas_modify_att(srcList, 'testIntA', modifyIntA)
call mpas_modify_att(srcList, 'testReal', modifyReal)
call mpas_modify_att(srcList, 'testRealA', modifyRealA)
call mpas_modify_att(srcList, 'testText', modifyText)

call mpas_get_att(srcList, 'testInt', destInt)
call mpas_get_att(srcList, 'testIntA', destIntA)
call mpas_get_att(srcList, 'testReal', destReal)
call mpas_get_att(srcList, 'testRealA', destRealA)
call mpas_get_att(srcList, 'testText', destText)

if ( destInt /= modifyInt ) then
threadErrs( threadNum ) = 1
call mpas_log_write(' Int not modified correctly', MPAS_LOG_ERR)
end if

if (sum(destIntA) /= sum(modifyIntA)) then
threadErrs( threadNum ) = 1
call mpas_log_write(' IntA not modified correctly', MPAS_LOG_ERR)
end if

if ( destReal /= modifyReal ) then
threadErrs( threadNum ) = 1
call mpas_log_write(' Real not modified correctly', MPAS_LOG_ERR)
end if

if ( sum(destRealA) /= sum(modifyRealA) ) then
threadErrs( threadNum ) = 1
call mpas_log_write(' RealA not modified correctly', MPAS_LOG_ERR)
end if

if ( trim(destText) /= trim(modifyText) ) then
threadErrs( threadNum ) = 1
call mpas_log_write(' Text not modified correctly', MPAS_LOG_ERR)
end if

call mpas_deallocate_attlist(srcList)
call mpas_deallocate_attlist(destList)

Expand Down
219 changes: 215 additions & 4 deletions src/framework/mpas_attlist.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,14 @@ module mpas_attlist
module procedure mpas_add_att_text
end interface mpas_add_att

interface mpas_modify_att
module procedure mpas_modify_att_int0d
module procedure mpas_modify_att_int1d
module procedure mpas_modify_att_real0d
module procedure mpas_modify_att_real1d
module procedure mpas_modify_att_text
end interface mpas_modify_att

interface mpas_get_att
module procedure mpas_get_att_int0d
module procedure mpas_get_att_int1d
Expand Down Expand Up @@ -118,7 +126,7 @@ subroutine mpas_add_att_int1d(attList, attName, attValue, ierr)!{{{
allocate(cursor % next)
cursor => cursor % next
end if

cursor % attType = MPAS_ATT_INTA
allocate(cursor % attValueIntA(size(attValue)))
write(cursor % attName,'(a)') trim(attName)
Expand Down Expand Up @@ -161,7 +169,7 @@ subroutine mpas_add_att_real0d(attList, attName, attValue, ierr)!{{{
allocate(cursor % next)
cursor => cursor % next
end if

cursor % attType = MPAS_ATT_REAL
write(cursor % attName,'(a)') trim(attName)
cursor % attValueReal = attValue
Expand Down Expand Up @@ -203,7 +211,7 @@ subroutine mpas_add_att_real1d(attList, attName, attValue, ierr)!{{{
allocate(cursor % next)
cursor => cursor % next
end if

cursor % attType = MPAS_ATT_REALA
allocate(cursor % attValueRealA(size(attValue)))
write(cursor % attName,'(a)') trim(attName)
Expand Down Expand Up @@ -246,13 +254,216 @@ subroutine mpas_add_att_text(attList, attName, attValue, ierr)!{{{
allocate(cursor % next)
cursor => cursor % next
end if

cursor % attType = MPAS_ATT_TEXT
write(cursor % attName,'(a)') trim(attName)
write(cursor % attValueText,'(a)') trim(attValue)

end subroutine mpas_add_att_text!}}}

!***********************************************************************
!
! routine mpas_modify_att_text
!
! > \brief MPAS modify text attribute routine
! > \author Matthew Dimond
! > \date 06/27/23
! > \details
! > This routine modifies a text attribute in the attribute list,
! > and returns a 1 in ierr if the attribute is not found, or the attribute
! > has a type incompatible with attValue.
!
!----------------------------------------------------------------------
subroutine mpas_modify_att_text(attList, attName, attValue, ierr)!{{{

implicit none

type (att_list_type), pointer :: attList !< Input/Output: Attribute List
character (len=*), intent(in) :: attName !< Input: Att. name to modify
character (len=*), intent(in) :: attValue !< Input: Updated Att. value
integer, intent(out), optional :: ierr !< Output: Error flag

type (att_list_type), pointer :: cursor

if (present(ierr)) ierr = 1

! Traverese list looking for attName
cursor => attlist
do while (associated(cursor))
if (trim(cursor % attName) == trim(attName)) then
if (cursor % attType == MPAS_ATT_TEXT) then
if (present(ierr)) ierr = 0
write(cursor % attValueText,'(a)') trim(attValue)
end if
return
end if
cursor => cursor % next
end do

end subroutine mpas_modify_att_text!}}}


!***********************************************************************
!
! routine mpas_modify_att_int0d
!
! > \brief MPAS modify 0D integer attribute routine
! > \author Matthew Dimond
! > \date 06/27/23
! > \details
! > This routine modifies a 0d integer attribute in the attribute list,
! > and returns a 1 in ierr if the attribute is not found, or the attribute
! > has a type incompatible with attValue.
!
!----------------------------------------------------------------------
subroutine mpas_modify_att_int0d(attList, attName, attValue, ierr)!{{{

implicit none

type (att_list_type), pointer :: attList !< Input/Output: Attribute List
character (len=*), intent(in) :: attName !< Input: Att. name to modify
integer, intent(in) :: attValue !< Input: Updated Att. value
integer, intent(out), optional :: ierr !< Output: Error flag

type (att_list_type), pointer :: cursor

if (present(ierr)) ierr = 1

! Traverese list looking for attName
cursor => attlist
do while (associated(cursor))
if (trim(cursor % attName) == trim(attName)) then
if (cursor % attType == MPAS_ATT_INT) then
cursor % attValueInt = attValue
end if
return
end if
cursor => cursor % next
end do


end subroutine mpas_modify_att_int0d!}}}

!***********************************************************************
!
! routine mpas_modify_att_int1d
!
! > \brief MPAS modify 1D integer attribute routine
! > \author Matthew Dimond
! > \date 06/27/23
! > \details
! > This routine modifies a 1d integer attribute in the attribute list,
! > and returns a 1 in ierr if the attribute is not found, or the attribute
! > has a type incompatible with attValue.
!
!----------------------------------------------------------------------
subroutine mpas_modify_att_int1d(attList, attName, attValue, ierr)!{{{

implicit none

type (att_list_type), pointer :: attList !< Input/Output: Attribute List
character (len=*), intent(in) :: attName !< Input: Att. name to modify
integer, dimension(:), intent(in) :: attValue !< Input: Updated Att. value
integer, intent(out), optional :: ierr !< Output: Error flag

type (att_list_type), pointer :: cursor

if (present(ierr)) ierr = 1

! Traverese list looking for attName
cursor => attlist
do while (associated(cursor))
if (trim(cursor % attName) == trim(attName)) then
if (cursor % attType == MPAS_ATT_INTA) then
cursor % attValueIntA(:) = attValue(:)
end if
return
end if
cursor => cursor % next
end do

end subroutine mpas_modify_att_int1d!}}}

!***********************************************************************
!
! routine mpas_modify_att_real0d
!
! > \brief MPAS modify 0D real attribute routine
! > \author Matthew Dimond
! > \date 06/27/23
! > \details
! > This routine modifies a 0d real attribute in the attribute list,
! > and returns a 1 in ierr if the attribute is not found, or the attribute
! > has a type incompatible with attValue.
!
!----------------------------------------------------------------------
subroutine mpas_modify_att_real0d(attList, attName, attValue, ierr)!{{{

implicit none

type (att_list_type), pointer :: attList !< Input/Output: Attribute List
character (len=*), intent(in) :: attName !< Input: Att. name to modify
real (kind=RKIND), intent(in) :: attValue !< Input: Updated Att. value
integer, intent(out), optional :: ierr !< Output: Error flag

type (att_list_type), pointer :: cursor

if (present(ierr)) ierr = 1

! Traverese list looking for attName
cursor => attlist
do while (associated(cursor))
if (trim(cursor % attName) == trim(attName)) then
if (cursor % attType == MPAS_ATT_REAL) then
cursor % attValueReal = attValue
end if
return
end if
cursor => cursor % next
end do

end subroutine mpas_modify_att_real0d!}}}

!***********************************************************************
!
! routine mpas_modify_att_real1d
!
! > \brief MPAS modify 1D real attribute routine
! > \author Matthew Dimond
! > \date 06/27/23
! > \details
! > This routine modifies a 1d real attribute in the attribute list,
! > and returns a 1 in ierr if the attribute is not found, or the attribute
! > has a type incompatible with attValue.
!
!----------------------------------------------------------------------
subroutine mpas_modify_att_real1d(attList, attName, attValue, ierr)!{{{

implicit none

type (att_list_type), pointer :: attList !< Input/Output: Attribute List
character (len=*), intent(in) :: attName !< Input: Att. name to modify
real (kind=RKIND), dimension(:), intent(in) :: attValue !< Input: Updated Att. value
integer, intent(out), optional :: ierr !< Output: Error flag

type (att_list_type), pointer :: cursor

if (present(ierr)) ierr = 1

! Traverese list looking for attName
cursor => attlist
do while (associated(cursor))
if (trim(cursor % attName) == trim(attName)) then
if (cursor % attType == MPAS_ATT_REALA) then
cursor % attValueRealA(:) = attValue(:)
end if
return
end if
cursor => cursor % next
end do

end subroutine mpas_modify_att_real1d!}}}

!***********************************************************************
!
! routine mpas_get_att_int0d
Expand Down

0 comments on commit 41b2bef

Please sign in to comment.