fixes #2657

GEOS-ESM · Mar 18, 2024 · c9ec05e · c9ec05e
1 parent b09ae30
commit c9ec05e
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 30 deletions.
diff --git 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
@@ -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)