From ab0a803c2e099d62e632cf625739017999da5cde Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Sun, 26 Oct 2025 00:03:55 +0200 Subject: [PATCH 1/5] enkf_clm_mod_5: modulearize SWC subroutines - `define_clm_statevec_swc` - `set_clm_statevec_swc` - `update_clm_swc` --- interface/model/eclm/enkf_clm_mod_5.F90 | 366 ++++++++++++++++-------- 1 file changed, 243 insertions(+), 123 deletions(-) diff --git a/interface/model/eclm/enkf_clm_mod_5.F90 b/interface/model/eclm/enkf_clm_mod_5.F90 index 259e2238..e44b4d0f 100755 --- a/interface/model/eclm/enkf_clm_mod_5.F90 +++ b/interface/model/eclm/enkf_clm_mod_5.F90 @@ -131,6 +131,96 @@ subroutine define_clm_statevec(mype) ! Soil Moisture DA: State vector index arrays if(clmupdate_swc==1) then + call define_clm_statevec_swc + endif + + if(clmupdate_swc==2) then + error stop "Not implemented: clmupdate_swc.eq.2" + endif + + if(clmupdate_texture==1) then + clm_statevecsize = clm_statevecsize + 2*((endg-begg+1)*nlevsoi) + endif + + if(clmupdate_texture==2) then + clm_statevecsize = clm_statevecsize + 3*((endg-begg+1)*nlevsoi) + endif + + !hcp LST DA + if(clmupdate_T==1) then + error stop "Not implemented: clmupdate_T.eq.1" + endif + !end hcp + +#ifdef PDAF_DEBUG + ! Debug output of clm_statevecsize + WRITE(*, '(a,x,a,i5,x,a,i10)') "TSMP-PDAF-debug", "mype(w)=", mype, "define_clm_statevec: clm_statevecsize=", clm_statevecsize +#endif + + !write(*,*) 'clm_statevecsize is ',clm_statevecsize + IF (allocated(clm_statevec)) deallocate(clm_statevec) + if ((clmupdate_swc/=0) .or. (clmupdate_T/=0) .or. (clmupdate_texture/=0)) then + !hcp added condition + allocate(clm_statevec(clm_statevecsize)) + end if + + ! Allocate statevector-duplicate for saving original column mean + ! values used in computing increments during updating the state + ! vector in column-mean-mode. + IF (allocated(clm_statevec_orig)) deallocate(clm_statevec_orig) + if (clmupdate_swc/=0 .and. clmstatevec_colmean/=0) then + allocate(clm_statevec_orig(clm_statevecsize)) + end if + + !write(*,*) 'clm_paramsize is ',clm_paramsize + if (allocated(clm_paramarr)) deallocate(clm_paramarr) !hcp + if ((clmupdate_T/=0)) then !hcp + error stop "Not implemented clmupdate_T.NE.0" + end if + + end subroutine define_clm_statevec + + + + + + subroutine define_clm_statevec_swc() + use decompMod , only : get_proc_bounds + use clm_varpar , only : nlevsoi + use clm_varcon , only : ispval + use ColumnType , only : col + + implicit none + + integer,intent(in) :: mype + + integer :: i + integer :: c + integer :: g + integer :: cc + + integer :: begp, endp ! per-proc beginning and ending pft indices + integer :: begc, endc ! per-proc beginning and ending column indices + integer :: begl, endl ! per-proc beginning and ending landunit indices + integer :: begg, endg ! per-proc gridcell ending gridcell indices + + + call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) + +#ifdef PDAF_DEBUG + WRITE(*,"(a,i5,a,i10,a,i10,a,i10,a,i10,a,i10,a,i10,a,i10,a,i10,a)") & + "TSMP-PDAF mype(w)=", mype, " define_clm_statevec, CLM5-bounds (g,l,c,p)----",& + begg,",",endg,",",begl,",",endl,",",begc,",",endc,",",begp,",",endp," -------" +#endif + + clm_begg = begg + clm_endg = endg + clm_begc = begc + clm_endc = endc + clm_begp = begp + clm_endp = endp + + ! Soil Moisture DA: State vector index arrays ! 1) COL/GRC: CLM->PDAF IF (allocated(state_clm2pdaf_p)) deallocate(state_clm2pdaf_p) @@ -283,54 +373,8 @@ subroutine define_clm_statevec(mype) #endif end do - endif - - if(clmupdate_swc==2) then - error stop "Not implemented: clmupdate_swc.eq.2" - endif - - if(clmupdate_texture==1) then - clm_statevecsize = clm_statevecsize + 2*((endg-begg+1)*nlevsoi) - endif - - if(clmupdate_texture==2) then - clm_statevecsize = clm_statevecsize + 3*((endg-begg+1)*nlevsoi) - endif - - !hcp LST DA - if(clmupdate_T==1) then - error stop "Not implemented: clmupdate_T.eq.1" - endif - !end hcp - -#ifdef PDAF_DEBUG - ! Debug output of clm_statevecsize - WRITE(*, '(a,x,a,i5,x,a,i10)') "TSMP-PDAF-debug", "mype(w)=", mype, "define_clm_statevec: clm_statevecsize=", clm_statevecsize -#endif - - !write(*,*) 'clm_statevecsize is ',clm_statevecsize - IF (allocated(clm_statevec)) deallocate(clm_statevec) - if ((clmupdate_swc/=0) .or. (clmupdate_T/=0) .or. (clmupdate_texture/=0)) then - !hcp added condition - allocate(clm_statevec(clm_statevecsize)) - end if - - ! Allocate statevector-duplicate for saving original column mean - ! values used in computing increments during updating the state - ! vector in column-mean-mode. - IF (allocated(clm_statevec_orig)) deallocate(clm_statevec_orig) - if (clmupdate_swc/=0 .and. clmstatevec_colmean/=0) then - allocate(clm_statevec_orig(clm_statevecsize)) - end if - - !write(*,*) 'clm_paramsize is ',clm_paramsize - if (allocated(clm_paramarr)) deallocate(clm_paramarr) !hcp - if ((clmupdate_T/=0)) then !hcp - error stop "Not implemented clmupdate_T.NE.0" - end if - - end subroutine define_clm_statevec - + end subroutine define_clm_statevec_swc + subroutine cleanup_clm_statevec() implicit none @@ -340,6 +384,7 @@ subroutine cleanup_clm_statevec() IF (allocated(state_pdaf2clm_c_p)) deallocate(state_pdaf2clm_c_p) IF (allocated(state_pdaf2clm_j_p)) deallocate(state_pdaf2clm_j_p) IF (allocated(state_clm2pdaf_p)) deallocate(state_clm2pdaf_p) + IF (allocated(clm_statevec_orig)) deallocate(clm_statevec_orig) end subroutine cleanup_clm_statevec @@ -384,12 +429,72 @@ subroutine set_clm_statevec(tstartcycle, mype) END IF #endif + if(clmupdate_swc==1) then + call set_clm_statevec_swc + end if + ! calculate shift when CRP data are assimilated if(clmupdate_swc==2) then error stop "Not implemented clmupdate_swc.eq.2" endif - if(clmupdate_swc/=0) then + !hcp LAI + if(clmupdate_T==1) then + error stop "Not implemented: clmupdate_T.eq.1" + endif + !end hcp LAI + + ! write average swc to state vector (CRP assimilation) + if(clmupdate_swc==2) then + error stop "Not implemented: clmupdate_swc.eq.2" + endif + + ! write texture values to state vector (if desired) + if(clmupdate_texture/=0) then + cc = 1 + do i=1,nlevsoi + do j=clm_begg,clm_endg + clm_statevec(cc+1*clm_varsize+offset) = psand(j,i) + clm_statevec(cc+2*clm_varsize+offset) = pclay(j,i) + if(clmupdate_texture==2) then + !incl. organic matter values + clm_statevec(cc+3*clm_varsize+offset) = porgm(j,i) + end if + cc = cc + 1 + end do + end do + endif + +#ifdef PDAF_DEBUG + IF(clmt_printensemble == tstartcycle + 1 .OR. clmt_printensemble < 0) THEN + ! TSMP-PDAF: For debug runs, output the state vector in files + WRITE(fn, "(a,i5.5,a,i5.5,a)") "clmstate_", mype, ".integrate.", tstartcycle + 1, ".txt" + OPEN(unit=71, file=fn, action="write") + DO i = 1, clm_statevecsize + WRITE (71,"(es22.15)") clm_statevec(i) + END DO + CLOSE(71) + END IF +#endif + + end subroutine set_clm_statevec + + + + subroutine set_clm_statevec_swc() + use clm_instMod, only : soilstate_inst, waterstate_inst + use clm_varpar , only : nlevsoi + use ColumnType , only : col + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + real(r8), pointer :: swc(:,:) + integer :: j,g,cc,c + integer :: n_c + + cc = 0 + + swc => waterstate_inst%h2osoi_vol_col + ! write swc values to state vector if (clmstatevec_colmean==1) then @@ -436,49 +541,9 @@ subroutine set_clm_statevec(tstartcycle, mype) clm_statevec(cc) = swc(state_pdaf2clm_c_p(cc), state_pdaf2clm_j_p(cc)) end do end if - endif - - !hcp LAI - if(clmupdate_T==1) then - error stop "Not implemented: clmupdate_T.eq.1" - endif - !end hcp LAI - - ! write average swc to state vector (CRP assimilation) - if(clmupdate_swc==2) then - error stop "Not implemented: clmupdate_swc.eq.2" - endif - - ! write texture values to state vector (if desired) - if(clmupdate_texture/=0) then - cc = 1 - do i=1,nlevsoi - do j=clm_begg,clm_endg - clm_statevec(cc+1*clm_varsize+offset) = psand(j,i) - clm_statevec(cc+2*clm_varsize+offset) = pclay(j,i) - if(clmupdate_texture==2) then - !incl. organic matter values - clm_statevec(cc+3*clm_varsize+offset) = porgm(j,i) - end if - cc = cc + 1 - end do - end do - endif - -#ifdef PDAF_DEBUG - IF(clmt_printensemble == tstartcycle + 1 .OR. clmt_printensemble < 0) THEN - ! TSMP-PDAF: For debug runs, output the state vector in files - WRITE(fn, "(a,i5.5,a,i5.5,a)") "clmstate_", mype, ".integrate.", tstartcycle + 1, ".txt" - OPEN(unit=71, file=fn, action="write") - DO i = 1, clm_statevecsize - WRITE (71,"(es22.15)") clm_statevec(i) - END DO - CLOSE(71) - END IF -#endif - - end subroutine set_clm_statevec + end subroutine set_clm_statevec_swc + subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") use clm_varpar , only : nlevsoi use clm_time_manager , only : update_DA_nstep @@ -579,6 +644,92 @@ subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") ! write updated swc back to CLM if(clmupdate_swc/=0) then + call update_clm_swc(tstartcycle, mype) + endif + + !hcp: TG, TV + if(clmupdate_T==1) then + error stop "Not implemented: clmupdate_T.eq.1" + endif + ! end hcp TG, TV + + !! update liquid water content + !do j=clm_begg,clm_endg + ! do i=1,nlevsoi + ! h2osoi_liq(j,i) = swc(j,i) * dz(j,i)*denh2o + ! end do + !end do + + ! write updated texture back to CLM + if(clmupdate_texture/=0) then + cc = 1 + do i=1,nlevsoi + do j=clm_begg,clm_endg + psand(j,i) = clm_statevec(cc+1*clm_varsize+offset) + pclay(j,i) = clm_statevec(cc+2*clm_varsize+offset) + if(clmupdate_texture==2) then + ! incl. organic matter + porgm(j,i) = clm_statevec(cc+3*clm_varsize+offset) + end if + cc = cc + 1 + end do + end do + call clm_correct_texture + call clm_texture_to_parameters + endif + + end subroutine update_clm + + + subroutine update_clm_swc(tstartcycle, mype) + use clm_varpar , only : nlevsoi + use shr_kind_mod , only : r8 => shr_kind_r8 + use ColumnType , only : col + use clm_instMod, only : soilstate_inst, waterstate_inst + use clm_varcon , only : denh2o, denice, watmin + use clm_varcon , only : ispval + use clm_varcon , only : spval + + implicit none + + integer,intent(in) :: tstartcycle + integer,intent(in) :: mype + + real(r8), pointer :: swc(:,:) + real(r8), pointer :: watsat(:,:) + + real(r8), pointer :: dz(:,:) ! layer thickness depth (m) + real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) + real(r8), pointer :: h2osoi_ice(:,:) + real(r8), pointer :: snow_depth(:) + real(r8), pointer :: liq_inc(:,:), ice_inc(:,:), snow_inc(:) + real(r8) :: rliq,rice + real(r8) :: watmin_check ! minimum soil moisture for checking clm_statevec (mm) + real(r8) :: watmin_set ! minimum soil moisture for setting swc (mm) + real(r8) :: swc_update ! updated SWC in loop + + integer :: i,j,cc + character (len = 31) :: fn2 !TSMP-PDAF: function name for state vector outpu + character (len = 32) :: fn3 !TSMP-PDAF: function name for state vector outpu + character (len = 32) :: fn4 !TSMP-PDAF: function name for state vector outpu + + logical :: swc_zero_before_update + + cc = 0 + swc_zero_before_update = .false. + + swc => waterstate_inst%h2osoi_vol_col + watsat => soilstate_inst%watsat_col + dz => col%dz + h2osoi_liq => waterstate_inst%h2osoi_liq_col + h2osoi_ice => waterstate_inst%h2osoi_ice_col + + snow_depth => waterstate_inst%snow_depth_col ! snow height of snow covered area (m) + + liq_inc => waterstate_inst%h2osoi_liq_col_inc + ice_inc => waterstate_inst%h2osoi_ice_col_inc + snow_inc => waterstate_inst%h2osno_col_inc + ! Set minimum soil moisture for checking the state vector and ! for setting minimum swc for CLM @@ -712,40 +863,9 @@ subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") END IF #endif - endif + end subroutine update_clm_swc - !hcp: TG, TV - if(clmupdate_T==1) then - error stop "Not implemented: clmupdate_T.eq.1" - endif - ! end hcp TG, TV - !! update liquid water content - !do j=clm_begg,clm_endg - ! do i=1,nlevsoi - ! h2osoi_liq(j,i) = swc(j,i) * dz(j,i)*denh2o - ! end do - !end do - - ! write updated texture back to CLM - if(clmupdate_texture/=0) then - cc = 1 - do i=1,nlevsoi - do j=clm_begg,clm_endg - psand(j,i) = clm_statevec(cc+1*clm_varsize+offset) - pclay(j,i) = clm_statevec(cc+2*clm_varsize+offset) - if(clmupdate_texture==2) then - ! incl. organic matter - porgm(j,i) = clm_statevec(cc+3*clm_varsize+offset) - end if - cc = cc + 1 - end do - end do - call clm_correct_texture - call clm_texture_to_parameters - endif - - end subroutine update_clm subroutine clm_correct_texture() From 56b6783da35ce6adc44299c0949a9275484fd6b6 Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Tue, 28 Oct 2025 13:22:30 +0100 Subject: [PATCH 2/5] remove unused variables, modular `update_clm_texture` --- interface/model/eclm/enkf_clm_mod_5.F90 | 108 +++++++++++------------- 1 file changed, 48 insertions(+), 60 deletions(-) diff --git a/interface/model/eclm/enkf_clm_mod_5.F90 b/interface/model/eclm/enkf_clm_mod_5.F90 index e44b4d0f..876c1463 100755 --- a/interface/model/eclm/enkf_clm_mod_5.F90 +++ b/interface/model/eclm/enkf_clm_mod_5.F90 @@ -89,11 +89,8 @@ module enkf_clm_mod #if defined CLMSA subroutine define_clm_statevec(mype) - use shr_kind_mod, only: r8 => shr_kind_r8 use decompMod , only : get_proc_bounds use clm_varpar , only : nlevsoi - use clm_varcon , only : ispval - use ColumnType , only : col implicit none @@ -157,13 +154,13 @@ subroutine define_clm_statevec(mype) WRITE(*, '(a,x,a,i5,x,a,i10)') "TSMP-PDAF-debug", "mype(w)=", mype, "define_clm_statevec: clm_statevecsize=", clm_statevecsize #endif - !write(*,*) 'clm_statevecsize is ',clm_statevecsize IF (allocated(clm_statevec)) deallocate(clm_statevec) if ((clmupdate_swc/=0) .or. (clmupdate_T/=0) .or. (clmupdate_texture/=0)) then !hcp added condition allocate(clm_statevec(clm_statevecsize)) end if + ! Allocate statevector-duplicate for saving original column mean ! values used in computing increments during updating the state ! vector in column-mean-mode. @@ -184,7 +181,7 @@ end subroutine define_clm_statevec - subroutine define_clm_statevec_swc() + subroutine define_clm_statevec_swc(mype) use decompMod , only : get_proc_bounds use clm_varpar , only : nlevsoi use clm_varcon , only : ispval @@ -544,48 +541,27 @@ subroutine set_clm_statevec_swc() end subroutine set_clm_statevec_swc + subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") - use clm_varpar , only : nlevsoi use clm_time_manager , only : update_DA_nstep use shr_kind_mod , only : r8 => shr_kind_r8 - use ColumnType , only : col - use clm_instMod, only : soilstate_inst, waterstate_inst - use clm_varcon , only : denh2o, denice, watmin - use clm_varcon , only : ispval - use clm_varcon , only : spval + use clm_instMod, only : waterstate_inst implicit none integer,intent(in) :: tstartcycle integer,intent(in) :: mype - real(r8), pointer :: swc(:,:) - real(r8), pointer :: watsat(:,:) - real(r8), pointer :: psand(:,:) - real(r8), pointer :: pclay(:,:) - real(r8), pointer :: porgm(:,:) - - real(r8), pointer :: dz(:,:) ! layer thickness depth (m) real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) real(r8), pointer :: h2osoi_ice(:,:) - real(r8), pointer :: snow_depth(:) - real(r8) :: rliq,rice - real(r8) :: watmin_check ! minimum soil moisture for checking clm_statevec (mm) - real(r8) :: watmin_set ! minimum soil moisture for setting swc (mm) - real(r8) :: swc_update ! updated SWC in loop - integer :: i,j,jj,g,cc,offset - character (len = 31) :: fn !TSMP-PDAF: function name for state vector outpu - character (len = 31) :: fn2 !TSMP-PDAF: function name for state vector outpu - character (len = 32) :: fn3 !TSMP-PDAF: function name for state vector outpu - character (len = 32) :: fn4 !TSMP-PDAF: function name for state vector outpu + integer :: i + character (len = 31) :: fn !TSMP-PDAF: function name for state vector output character (len = 32) :: fn5 !TSMP-PDAF: function name for state vector outpu character (len = 32) :: fn6 !TSMP-PDAF: function name for state vector outpu logical :: swc_zero_before_update - cc = 0 - offset = 0 swc_zero_before_update = .false. #ifdef PDAF_DEBUG @@ -600,15 +576,6 @@ subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") END IF #endif - swc => waterstate_inst%h2osoi_vol_col - watsat => soilstate_inst%watsat_col - psand => soilstate_inst%cellsand_col - pclay => soilstate_inst%cellclay_col - porgm => soilstate_inst%cellorg_col - - snow_depth => waterstate_inst%snow_depth_col ! snow height of snow covered area (m) - - dz => col%dz h2osoi_liq => waterstate_inst%h2osoi_liq_col h2osoi_ice => waterstate_inst%h2osoi_ice_col @@ -653,29 +620,9 @@ subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") endif ! end hcp TG, TV - !! update liquid water content - !do j=clm_begg,clm_endg - ! do i=1,nlevsoi - ! h2osoi_liq(j,i) = swc(j,i) * dz(j,i)*denh2o - ! end do - !end do - ! write updated texture back to CLM if(clmupdate_texture/=0) then - cc = 1 - do i=1,nlevsoi - do j=clm_begg,clm_endg - psand(j,i) = clm_statevec(cc+1*clm_varsize+offset) - pclay(j,i) = clm_statevec(cc+2*clm_varsize+offset) - if(clmupdate_texture==2) then - ! incl. organic matter - porgm(j,i) = clm_statevec(cc+3*clm_varsize+offset) - end if - cc = cc + 1 - end do - end do - call clm_correct_texture - call clm_texture_to_parameters + call update_clm_texture(tstartcycle, mype) endif end subroutine update_clm @@ -866,6 +813,47 @@ subroutine update_clm_swc(tstartcycle, mype) end subroutine update_clm_swc + subroutine update_clm_texture(tstartcycle, mype) + use clm_varpar , only : nlevsoi + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_instMod, only : soilstate_inst + + implicit none + + integer,intent(in) :: tstartcycle + integer,intent(in) :: mype + + integer :: i,j,cc,offset + + real(r8), pointer :: psand(:,:) + real(r8), pointer :: pclay(:,:) + real(r8), pointer :: porgm(:,:) + + cc = 0 + offset = 0 + + psand => soilstate_inst%cellsand_col + pclay => soilstate_inst%cellclay_col + porgm => soilstate_inst%cellorg_col + + cc = 1 + do i=1,nlevsoi + do j=clm_begg,clm_endg + psand(j,i) = clm_statevec(cc+1*clm_varsize+offset) + pclay(j,i) = clm_statevec(cc+2*clm_varsize+offset) + if(clmupdate_texture==2) then + ! incl. organic matter + porgm(j,i) = clm_statevec(cc+3*clm_varsize+offset) + end if + cc = cc + 1 + end do + end do + call clm_correct_texture + call clm_texture_to_parameters + + end subroutine update_clm_texture + + subroutine clm_correct_texture() From e55e4daafad1f828a5f6a42fa501490f47068887 Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Tue, 28 Oct 2025 13:35:25 +0100 Subject: [PATCH 3/5] further adaptions --- interface/model/eclm/enkf_clm_mod_5.F90 | 32 ++++++++++--------------- 1 file changed, 12 insertions(+), 20 deletions(-) diff --git a/interface/model/eclm/enkf_clm_mod_5.F90 b/interface/model/eclm/enkf_clm_mod_5.F90 index 876c1463..ccc90bcb 100755 --- a/interface/model/eclm/enkf_clm_mod_5.F90 +++ b/interface/model/eclm/enkf_clm_mod_5.F90 @@ -96,15 +96,6 @@ subroutine define_clm_statevec(mype) integer,intent(in) :: mype - integer :: i - integer :: j - integer :: jj - integer :: c - integer :: g - integer :: cg - integer :: cc - integer :: cccheck - integer :: begp, endp ! per-proc beginning and ending pft indices integer :: begc, endc ! per-proc beginning and ending column indices integer :: begl, endl ! per-proc beginning and ending landunit indices @@ -126,27 +117,30 @@ subroutine define_clm_statevec(mype) clm_begp = begp clm_endp = endp - ! Soil Moisture DA: State vector index arrays + ! soil water content observations - case 1 if(clmupdate_swc==1) then - call define_clm_statevec_swc - endif + call define_clm_statevec_swc(mype) + end if + ! soil water content observations - case 2 if(clmupdate_swc==2) then error stop "Not implemented: clmupdate_swc.eq.2" - endif + end if + ! texture observations - case 1 if(clmupdate_texture==1) then - clm_statevecsize = clm_statevecsize + 2*((endg-begg+1)*nlevsoi) - endif + clm_statevecsize = clm_statevecsize + 2*((endg-begg+1)*nlevsoi) + end if + ! texture observations - case 2 if(clmupdate_texture==2) then - clm_statevecsize = clm_statevecsize + 3*((endg-begg+1)*nlevsoi) - endif + clm_statevecsize = clm_statevecsize + 3*((endg-begg+1)*nlevsoi) + end if !hcp LST DA if(clmupdate_T==1) then error stop "Not implemented: clmupdate_T.eq.1" - endif + end if !end hcp #ifdef PDAF_DEBUG @@ -787,7 +781,6 @@ subroutine update_clm_swc(tstartcycle, mype) #ifdef PDAF_DEBUG IF(clmt_printensemble == tstartcycle .OR. clmt_printensemble < 0) THEN - IF(clmupdate_swc/=0) THEN ! TSMP-PDAF: For debug runs, output the state vector in files WRITE(fn3, "(a,i5.5,a,i5.5,a)") "h2osoi_liq", mype, ".update.", tstartcycle, ".txt" OPEN(unit=71, file=fn3, action="write") @@ -805,7 +798,6 @@ subroutine update_clm_swc(tstartcycle, mype) OPEN(unit=71, file=fn2, action="write") WRITE (71,"(es22.15)") swc(:,:) CLOSE(71) - END IF END IF #endif From 7b0a804093a8ff43ed0511e30e16393f9a8c7c4d Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Tue, 28 Oct 2025 13:39:26 +0100 Subject: [PATCH 4/5] whitespace fixes --- interface/model/eclm/enkf_clm_mod_5.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/interface/model/eclm/enkf_clm_mod_5.F90 b/interface/model/eclm/enkf_clm_mod_5.F90 index ccc90bcb..971ceb9f 100755 --- a/interface/model/eclm/enkf_clm_mod_5.F90 +++ b/interface/model/eclm/enkf_clm_mod_5.F90 @@ -365,7 +365,7 @@ subroutine define_clm_statevec_swc(mype) end do end subroutine define_clm_statevec_swc - + subroutine cleanup_clm_statevec() implicit none @@ -534,7 +534,7 @@ subroutine set_clm_statevec_swc() end if end subroutine set_clm_statevec_swc - + subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") use clm_time_manager , only : update_DA_nstep From 046ec896f0e77c8a43abcdca838583ce7e0d2c4e Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Tue, 28 Oct 2025 14:49:41 +0100 Subject: [PATCH 5/5] remove accidentally added GRACE pointers --- interface/model/eclm/enkf_clm_mod_5.F90 | 6 ------ 1 file changed, 6 deletions(-) diff --git a/interface/model/eclm/enkf_clm_mod_5.F90 b/interface/model/eclm/enkf_clm_mod_5.F90 index 971ceb9f..6375471d 100755 --- a/interface/model/eclm/enkf_clm_mod_5.F90 +++ b/interface/model/eclm/enkf_clm_mod_5.F90 @@ -643,7 +643,6 @@ subroutine update_clm_swc(tstartcycle, mype) real(r8), pointer :: h2osoi_liq(:,:) ! liquid water (kg/m2) real(r8), pointer :: h2osoi_ice(:,:) real(r8), pointer :: snow_depth(:) - real(r8), pointer :: liq_inc(:,:), ice_inc(:,:), snow_inc(:) real(r8) :: rliq,rice real(r8) :: watmin_check ! minimum soil moisture for checking clm_statevec (mm) real(r8) :: watmin_set ! minimum soil moisture for setting swc (mm) @@ -667,11 +666,6 @@ subroutine update_clm_swc(tstartcycle, mype) snow_depth => waterstate_inst%snow_depth_col ! snow height of snow covered area (m) - liq_inc => waterstate_inst%h2osoi_liq_col_inc - ice_inc => waterstate_inst%h2osoi_ice_col_inc - snow_inc => waterstate_inst%h2osno_col_inc - - ! Set minimum soil moisture for checking the state vector and ! for setting minimum swc for CLM if(clmwatmin_switch==3) then