From c9ec05e0f4f5e0e2c4bc4d60c5c23f97a5c1ae4b Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 18 Mar 2024 16:17:44 -0400 Subject: [PATCH 1/3] fixes #2657 --- CHANGELOG.md | 2 + gridcomps/History/MAPL_HistoryGridComp.F90 | 63 +++++++++++----------- 2 files changed, 35 insertions(+), 30 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6dcd08ebfdcf..0812c1bd2f26 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed +- Fix bug where bit-shaved, instantaneous binary output in History was modifying the original export state passed + ### Removed ### Deprecated diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 9f5329b99ec5..279b52f67037 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3253,7 +3253,8 @@ subroutine Run ( gc, import, export, clock, rc ) integer :: n,m logical, allocatable :: NewSeg(:) logical, allocatable :: Writing(:) - type(ESMF_State) :: state_out + type(ESMF_State) :: state_out, final_state + type(ESMF_Field) :: temp_field, state_field integer :: nymd, nhms character(len=ESMF_MAXSTR) :: DateStamp type(ESMF_Time) :: current_time @@ -3626,12 +3627,23 @@ subroutine Run ( gc, import, export, clock, rc ) INTSTATE%LCTL(n) = .false. endif - call shavebits(state_out, list(n), _RC) - do m=1,list(n)%field_set%nfields - call MAPL_VarWrite ( list(n)%unit, STATE=state_out, & - NAME=trim(list(n)%field_set%fields(3,m)), & - forceWriteNoRestart=.true., _RC ) + if (list(n)%nbits_to_keep >=MAPL_NBITS_UPPER_LIMIT) then + call MAPL_VarWrite ( list(n)%unit, STATE=state_out, & + NAME=trim(list(n)%field_set%fields(3,m)), & + forceWriteNoRestart=.true., _RC ) + else + call ESMF_StateGet(state_out,trim(list(n)%field_set%fields(3,m)),state_field,_RC) + temp_field = MAPL_FieldCreate(state_field,list(n)%field_set%fields(3,m),DoCopy=.true.,_RC) + call shavebits(temp_field, list(n), _RC) + final_state = ESMF_StateCreate(fieldlist=[temp_field],_RC) + call ESMF_AttributeCopy(state_out,final_state,_RC) + call MAPL_VarWrite ( list(n)%unit, STATE=final_state, & + NAME=trim(list(n)%field_set%fields(3,m)), & + forceWriteNoRestart=.true., _RC ) + call ESMF_FieldDestroy(temp_field,noGarbage=.true.,_RC) + call ESMF_StateDestroy(final_state,noGarbage=.true.,_RC) + endif enddo call WRITE_PARALLEL("Wrote GrADS Output for File: "//trim(filename(n))) @@ -5154,40 +5166,31 @@ subroutine checkIfStateHasField(state, fieldName, hasField, rc) _RETURN(ESMF_SUCCESS) end subroutine checkIfStateHasField - subroutine shavebits( state, list, rc) - type(ESMF_state), intent(inout) :: state + subroutine shavebits( field, list, rc) + type(ESMF_field), intent(inout) :: field type (HistoryCollection), intent(in) :: list integer, optional, intent(out):: rc integer :: m, fieldRank, status - type(ESMF_Field) :: field real, pointer :: ptr1d(:), ptr2d(:,:), ptr3d(:,:,:) type(ESMF_VM) :: vm integer :: comm - if (list%nbits_to_keep >=MAPL_NBITS_UPPER_LIMIT) then - _RETURN(ESMF_SUCCESS) - endif - call ESMF_VMGetCurrent(vm,_RC) call ESMF_VMGet(vm,mpiCommunicator=comm,_RC) - - do m=1,list%field_set%nfields - call ESMF_StateGet(state, trim(list%field_set%fields(3,m)),field,_RC ) - call ESMF_FieldGet(field, rank=fieldRank,_RC) - if (fieldRank ==1) then - call ESMF_FieldGet(field, farrayptr=ptr1d, _RC) - call DownBit(ptr1d,ptr1d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) - elseif (fieldRank ==2) then - call ESMF_FieldGet(field, farrayptr=ptr2d, _RC) - call DownBit(ptr2d,ptr2d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) - elseif (fieldRank ==3) then - call ESMF_FieldGet(field, farrayptr=ptr3d, _RC) - call DownBit(ptr3d,ptr3d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) - else - _FAIL('The field rank is not implmented') - endif - enddo + call ESMF_FieldGet(field, rank=fieldRank,_RC) + if (fieldRank ==1) then + call ESMF_FieldGet(field, farrayptr=ptr1d, _RC) + call DownBit(ptr1d,ptr1d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) + elseif (fieldRank ==2) then + call ESMF_FieldGet(field, farrayptr=ptr2d, _RC) + call DownBit(ptr2d,ptr2d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) + elseif (fieldRank ==3) then + call ESMF_FieldGet(field, farrayptr=ptr3d, _RC) + call DownBit(ptr3d,ptr3d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) + else + _FAIL('The field rank is not implmented') + endif _RETURN(ESMF_SUCCESS) From 9c31ea7d069333e77616b0f2e62060ea691c58bd Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 19 Mar 2024 08:35:04 -0400 Subject: [PATCH 2/3] Prepare for 2.44.1 Release --- CHANGELOG.md | 8 ++++++-- CMakeLists.txt | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0812c1bd2f26..b2938757f332 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,12 +13,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed -- Fix bug where bit-shaved, instantaneous binary output in History was modifying the original export state passed - ### Removed ### Deprecated +## [2.44.1] - 2024-03-19 + +### Fixed + +- Fix bug where bit-shaved, instantaneous binary output in History was modifying the original export state passed + ## [2.44.0] - 2024-02-08 ### Added diff --git a/CMakeLists.txt b/CMakeLists.txt index 5e2df2da13e6..b88a43b45e27 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.44.0 + VERSION 2.44.1 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui From 48e19d7cdfb62415dc8e4ffa4c9e046045b2fc84 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 19 Mar 2024 15:23:05 -0400 Subject: [PATCH 3/3] first try was wrong need to copy whole state --- gridcomps/History/MAPL_HistoryGridComp.F90 | 61 ++++++++++++++-------- 1 file changed, 39 insertions(+), 22 deletions(-) diff --git a/gridcomps/History/MAPL_HistoryGridComp.F90 b/gridcomps/History/MAPL_HistoryGridComp.F90 index 279b52f67037..3f78d05004bd 100644 --- a/gridcomps/History/MAPL_HistoryGridComp.F90 +++ b/gridcomps/History/MAPL_HistoryGridComp.F90 @@ -3627,24 +3627,36 @@ subroutine Run ( gc, import, export, clock, rc ) INTSTATE%LCTL(n) = .false. endif + if (list(n)%nbits_to_keep < MAPL_NBITS_UPPER_LIMIT) then + final_state = ESMF_StateCreate(_RC) + do m=1,list(n)%field_set%nfields + call ESMF_StateGet(state_out,trim(list(n)%field_set%fields(3,m)),state_field,_RC) + temp_field = MAPL_FieldCreate(state_field,list(n)%field_set%fields(3,m),DoCopy=.true.,_RC) + call ESMF_StateAdd(final_state,[temp_field],_RC) + enddo + call ESMF_AttributeCopy(state_out,final_state,_RC) + call shavebits(final_state,list(n),_RC) + end if + do m=1,list(n)%field_set%nfields if (list(n)%nbits_to_keep >=MAPL_NBITS_UPPER_LIMIT) then call MAPL_VarWrite ( list(n)%unit, STATE=state_out, & NAME=trim(list(n)%field_set%fields(3,m)), & forceWriteNoRestart=.true., _RC ) else - call ESMF_StateGet(state_out,trim(list(n)%field_set%fields(3,m)),state_field,_RC) - temp_field = MAPL_FieldCreate(state_field,list(n)%field_set%fields(3,m),DoCopy=.true.,_RC) - call shavebits(temp_field, list(n), _RC) - final_state = ESMF_StateCreate(fieldlist=[temp_field],_RC) - call ESMF_AttributeCopy(state_out,final_state,_RC) call MAPL_VarWrite ( list(n)%unit, STATE=final_state, & NAME=trim(list(n)%field_set%fields(3,m)), & forceWriteNoRestart=.true., _RC ) - call ESMF_FieldDestroy(temp_field,noGarbage=.true.,_RC) - call ESMF_StateDestroy(final_state,noGarbage=.true.,_RC) endif enddo + + if (list(n)%nbits_to_keep < MAPL_NBITS_UPPER_LIMIT) then + do m=1,list(n)%field_set%nfields + call ESMF_StateGet(final_state,trim(list(n)%field_set%fields(3,m)),temp_field,_RC) + call ESMF_FieldDestroy(temp_field,noGarbage=.true.,_RC) + enddo + call ESMF_StateDestroy(final_state,noGarbage=.true.,_RC) + end if call WRITE_PARALLEL("Wrote GrADS Output for File: "//trim(filename(n))) end if IOTYPE @@ -5166,31 +5178,36 @@ subroutine checkIfStateHasField(state, fieldName, hasField, rc) _RETURN(ESMF_SUCCESS) end subroutine checkIfStateHasField - subroutine shavebits( field, list, rc) - type(ESMF_field), intent(inout) :: field + subroutine shavebits( state, list, rc) + type(ESMF_state), intent(inout) :: state type (HistoryCollection), intent(in) :: list integer, optional, intent(out):: rc integer :: m, fieldRank, status + type(ESMF_Field) :: field real, pointer :: ptr1d(:), ptr2d(:,:), ptr3d(:,:,:) type(ESMF_VM) :: vm integer :: comm call ESMF_VMGetCurrent(vm,_RC) call ESMF_VMGet(vm,mpiCommunicator=comm,_RC) - call ESMF_FieldGet(field, rank=fieldRank,_RC) - if (fieldRank ==1) then - call ESMF_FieldGet(field, farrayptr=ptr1d, _RC) - call DownBit(ptr1d,ptr1d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) - elseif (fieldRank ==2) then - call ESMF_FieldGet(field, farrayptr=ptr2d, _RC) - call DownBit(ptr2d,ptr2d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) - elseif (fieldRank ==3) then - call ESMF_FieldGet(field, farrayptr=ptr3d, _RC) - call DownBit(ptr3d,ptr3d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) - else - _FAIL('The field rank is not implmented') - endif + + do m=1,list%field_set%nfields + call ESMF_StateGet(state, trim(list%field_set%fields(3,m)),field,_RC ) + call ESMF_FieldGet(field, rank=fieldRank,_RC) + if (fieldRank ==1) then + call ESMF_FieldGet(field, farrayptr=ptr1d, _RC) + call DownBit(ptr1d,ptr1d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) + elseif (fieldRank ==2) then + call ESMF_FieldGet(field, farrayptr=ptr2d, _RC) + call DownBit(ptr2d,ptr2d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) + elseif (fieldRank ==3) then + call ESMF_FieldGet(field, farrayptr=ptr3d, _RC) + call DownBit(ptr3d,ptr3d,list%nbits_to_keep,undef=MAPL_undef,mpi_comm=comm,_RC) + else + _FAIL('The field rank is not implmented') + endif + enddo _RETURN(ESMF_SUCCESS)