first try was wrong

need to copy whole state
GEOS-ESM · Mar 19, 2024 · 48e19d7 · 48e19d7
1 parent 9c31ea7
commit 48e19d7
Showing 1 changed file with 39 additions and 22 deletions.
diff --git 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)