From 6cdcc7d63042feb8a18c190a1f1f94c6181fb0a7 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 11:41:45 -0500 Subject: [PATCH 01/66] Merging SM old code with current develop --- .../GEOS_SurfaceGridComp.F90 | 73 ++++++++++++++----- .../GEOSland_GridComp/GEOS_LandGridComp.F90 | 4 + .../GEOS_CatchCNGridComp.F90 | 2 + .../GEOS_CatchCNCLM40GridComp.F90 | 28 ++++++- .../GEOS_CatchCNCLM45GridComp.F90 | 34 ++++++++- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 26 +++++++ 6 files changed, 145 insertions(+), 22 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index 2f2a2fbd4..b3ad1c1a8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -2697,6 +2697,24 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'depth_to_water_table_from_surface',& + UNITS = 'm' ,& + SHORT_NAME = 'WATERTABLED' ,& + DIMS = MAPL_DimsHorzOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FSWCHANGE' + DIMS = MAPL_DimsHorzOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + IF(LSM_CHOICE > 1) THEN call MAPL_AddExportSpec(GC ,& LONG_NAME = 'CN_exposed_leaf-area_index',& @@ -5052,24 +5070,26 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: T2MWET => NULL() ! GOSWIM (internal/export variables from catch/catchcn) - real, pointer, dimension(:,:,:) :: RDU001 => NULL() - real, pointer, dimension(:,:,:) :: RDU002 => NULL() - real, pointer, dimension(:,:,:) :: RDU003 => NULL() - real, pointer, dimension(:,:,:) :: RDU004 => NULL() - real, pointer, dimension(:,:,:) :: RDU005 => NULL() - real, pointer, dimension(:,:,:) :: RBC001 => NULL() - real, pointer, dimension(:,:,:) :: RBC002 => NULL() - real, pointer, dimension(:,:,:) :: ROC001 => NULL() - real, pointer, dimension(:,:,:) :: ROC002 => NULL() - real, pointer, dimension(:,:) :: RMELTDU001 => NULL() - real, pointer, dimension(:,:) :: RMELTDU002 => NULL() - real, pointer, dimension(:,:) :: RMELTDU003 => NULL() - real, pointer, dimension(:,:) :: RMELTDU004 => NULL() - real, pointer, dimension(:,:) :: RMELTDU005 => NULL() - real, pointer, dimension(:,:) :: RMELTBC001 => NULL() - real, pointer, dimension(:,:) :: RMELTBC002 => NULL() - real, pointer, dimension(:,:) :: RMELTOC001 => NULL() - real, pointer, dimension(:,:) :: RMELTOC002 => NULL() + real, pointer, dimension(:,:,:) :: RDU001 => NULL() + real, pointer, dimension(:,:,:) :: RDU002 => NULL() + real, pointer, dimension(:,:,:) :: RDU003 => NULL() + real, pointer, dimension(:,:,:) :: RDU004 => NULL() + real, pointer, dimension(:,:,:) :: RDU005 => NULL() + real, pointer, dimension(:,:,:) :: RBC001 => NULL() + real, pointer, dimension(:,:,:) :: RBC002 => NULL() + real, pointer, dimension(:,:,:) :: ROC001 => NULL() + real, pointer, dimension(:,:,:) :: ROC002 => NULL() + real, pointer, dimension(:,:) :: RMELTDU001 => NULL() + real, pointer, dimension(:,:) :: RMELTDU002 => NULL() + real, pointer, dimension(:,:) :: RMELTDU003 => NULL() + real, pointer, dimension(:,:) :: RMELTDU004 => NULL() + real, pointer, dimension(:,:) :: RMELTDU005 => NULL() + real, pointer, dimension(:,:) :: RMELTBC001 => NULL() + real, pointer, dimension(:,:) :: RMELTBC002 => NULL() + real, pointer, dimension(:,:) :: RMELTOC001 => NULL() + real, pointer, dimension(:,:) :: RMELTOC002 => NULL() + real, pointer, dimension(:,:) :: WATERTABLED => NULL() + real, pointer, dimension(:,:) :: FSWCHANGE => NULL() ! CN model real, pointer, dimension(:,:) :: CNLAI => NULL() @@ -5329,6 +5349,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:) :: RMELTBC002TILE => NULL() real, pointer, dimension(:) :: RMELTOC001TILE => NULL() real, pointer, dimension(:) :: RMELTOC002TILE => NULL() + real, pointer, dimension(:) :: WATERTABLEDTILE => NULL() + real, pointer, dimension(:) :: FSWCHANGETILE => NULL() real, pointer, dimension(:) :: CNLAITILE => NULL() real, pointer, dimension(:) :: CNTLAITILE => NULL() @@ -6141,6 +6163,9 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , RMELTBC002 , 'RMELTBC002', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , RMELTOC001 , 'RMELTOC001', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , RMELTOC002 , 'RMELTOC002', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , WATERTABLED, 'WATERTABLED', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , FSWCHANGE , 'FSWCHANGE', RC=STATUS); VERIFY_(STATUS) + IF(LSM_CHOICE > 1) THEN call MAPL_GetPointer(EXPORT , CNLAI , 'CNLAI' , RC=STATUS); VERIFY_(STATUS) @@ -6714,6 +6739,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MKTILE(RMELTBC002 ,RMELTBC002TILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(RMELTOC001 ,RMELTOC001TILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(RMELTOC002 ,RMELTOC002TILE ,NT,RC=STATUS); VERIFY_(STATUS) + call MKTILE(WATERTABLED,WATERTABLEDTILE,NT,RC=STATUS); VERIFY_(STATUS) + call MKTILE(FSWCHANGE ,FSWCHANGETILE ,NT,RC=STATUS); VERIFY_(STATUS) IF (LSM_CHOICE > 1) THEN call MKTILE(CNLAI ,CNLAITILE ,NT,RC=STATUS); VERIFY_(STATUS) @@ -7541,6 +7568,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) if(associated(RMELTBC002))call MAPL_LocStreamTransform( LOCSTREAM,RMELTBC002 ,RMELTBC002TILE, RC=STATUS); VERIFY_(STATUS) if(associated(RMELTOC001))call MAPL_LocStreamTransform( LOCSTREAM,RMELTOC001 ,RMELTOC001TILE, RC=STATUS); VERIFY_(STATUS) if(associated(RMELTOC002))call MAPL_LocStreamTransform( LOCSTREAM,RMELTOC002 ,RMELTOC002TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(WATERTABLED))call MAPL_LocStreamTransform( LOCSTREAM,WATERTABLED ,WATERTABLEDTILE, RC=STATUS); VERIFY_(STATUS) + if(associated(FSWCHANGE ))call MAPL_LocStreamTransform( LOCSTREAM,FSWCHANGE ,FSWCHANGETILE , RC=STATUS); VERIFY_(STATUS) if(associated(CNLAI)) then call MAPL_LocStreamTransform( LOCSTREAM,CNLAI ,CNLAITILE , RC=STATUS) @@ -8074,6 +8103,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) if(associated(RMELTBC002TILE )) deallocate(RMELTBC002TILE ) if(associated(RMELTOC001TILE )) deallocate(RMELTOC001TILE ) if(associated(RMELTOC002TILE )) deallocate(RMELTOC002TILE ) + if(associated(WATERTABLEDTILE)) deallocate(WATERTABLEDTILE) + if(associated(FSWCHANGETILE )) deallocate(FSWCHANGETILE ) if(associated(CNLAITILE )) deallocate(CNLAITILE ) if(associated(CNTLAITILE )) deallocate(CNTLAITILE ) if(associated(CNSAITILE )) deallocate(CNSAITILE ) @@ -8409,6 +8440,10 @@ subroutine DOTYPE(type,RC) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'RMELTOC002' , ALLOC=associated(RMELTOC002TILE ), notFoundOK=.true., RC=STATUS) VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'WATERTABLED', ALLOC=associated(WATERTABLEDTILE ),notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(GEX(type), dum, 'FSWCHANGE' , ALLOC=associated(FSWCHANGETILE ) , notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) IF (LSM_CHOICE > 1) THEN call MAPL_GetPointer(GEX(type), dum, 'CNLAI' , ALLOC=associated(CNLAITILE ), notFoundOK=.true., RC=STATUS) @@ -8977,6 +9012,8 @@ subroutine DOTYPE(type,RC) if(associated(RMELTBC002TILE)) call FILLOUT_TILE(GEX(type), 'RMELTBC002' , RMELTBC002TILE , XFORM, RC=STATUS);VERIFY_(STATUS) if(associated(RMELTOC001TILE)) call FILLOUT_TILE(GEX(type), 'RMELTOC001' , RMELTOC001TILE , XFORM, RC=STATUS);VERIFY_(STATUS) if(associated(RMELTOC002TILE)) call FILLOUT_TILE(GEX(type), 'RMELTOC002' , RMELTOC002TILE , XFORM, RC=STATUS);VERIFY_(STATUS) + if(associated(WATERTABLEDTILE))call FILLOUT_TILE(GEX(type), 'WATERTABLED', WATERTABLEDTILE, XFORM, RC=STATUS);VERIFY_(STATUS) + if(associated(FSWCHANGETILE)) call FILLOUT_TILE(GEX(type), 'FSWCHANGE' , FSWCHANGETILE , XFORM, RC=STATUS);VERIFY_(STATUS) if(associated(CNLAITILE)) then call FILLOUT_TILE(GEX(type), 'CNLAI' , CNLAITILE , XFORM, RC=STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index fd981de57..bfca66893 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -920,6 +920,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTBC002', CHILD_ID = CATCH(1), RC=STATUS) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTOC001', CHILD_ID = CATCH(1), RC=STATUS) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTOC002', CHILD_ID = CATCH(1), RC=STATUS) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'WATERTABLED',CHILD_ID = CATCH(1), RC=STATUS) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FSWCHANGE', CHILD_ID = CATCH(1), RC=STATUS) ; VERIFY_(STATUS) if (DO_GOSWIM /= 0) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RDU001', CHILD_ID = CATCH(1), RC=STATUS) ; VERIFY_(STATUS) @@ -1290,6 +1292,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTBC002', CHILD_ID = CATCHCN(1), RC=STATUS) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTOC001', CHILD_ID = CATCHCN(1), RC=STATUS) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTOC002', CHILD_ID = CATCHCN(1), RC=STATUS) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'WATERTABLED',CHILD_ID = CATCHCN(1), RC=STATUS) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FSWCHANGE', CHILD_ID = CATCHCN(1), RC=STATUS) ; VERIFY_(STATUS) if (DO_GOSWIM /= 0) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RDU001', CHILD_ID = CATCHCN(1), RC=STATUS) ; VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 index 1e385acb2..e790bcd5f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOS_CatchCNGridComp.F90 @@ -984,6 +984,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTBC002', CHILD_ID = CATCHCN, RC=STATUS) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTOC001', CHILD_ID = CATCHCN, RC=STATUS) ; VERIFY_(STATUS) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RMELTOC002', CHILD_ID = CATCHCN, RC=STATUS) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'WATERTABLED',CHILD_ID = CATCHCN, RC=STATUS) ; VERIFY_(STATUS) + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FSWCHANGE' , CHILD_ID = CATCHCN, RC=STATUS) ; VERIFY_(STATUS) if (DO_GOSWIM /= 0) then call MAPL_AddExportSpec ( GC, SHORT_NAME = 'RDU001', CHILD_ID = CATCHCN, RC=STATUS) ; VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index c2e190653..f40c286fe 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -3731,7 +3731,25 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'RMELTOC002' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'depth_to_water_table_from_surface',& + UNITS = 'm' ,& + SHORT_NAME = 'WATERTABLED' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FSWCHANGE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) VERIFY_(STATUS) !EOS @@ -4891,6 +4909,8 @@ subroutine Driver ( RC ) real, pointer, dimension(:) :: RMELTOC001 real, pointer, dimension(:) :: RMELTOC002 real, pointer, dimension(:) :: IRRIGRATE + real, pointer, dimension(:) :: WATERTABLED + real, pointer, dimension(:) :: FSWCHANGE ! -------------------------------------------------------------------------- ! Local pointers for tile variables @@ -5536,6 +5556,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,RMELTBC002,'RMELTBC002', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTOC001,'RMELTOC001', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTOC002,'RMELTOC002', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WATERTABLED,'WATERTABLED',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWCHANGE, 'FSWCHANGE', RC=STATUS); VERIFY_(STATUS) IF (RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) NTILES = size(PS) @@ -7786,6 +7808,10 @@ subroutine Driver ( RC ) if(associated(RMELTBC002)) RMELTBC002 = RMELT(:,7) if(associated(RMELTOC001)) RMELTOC001 = RMELT(:,8) if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) + if(associated(FSWCHANGE)) FSWCHANGE = FSW_CHANGE + if(associated(WATERTABLED)) then + WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) + endif if(associated(TPSN1OUT)) then where(WESNN(1,:)>0.) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 82d783104..0bff5901b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -3668,9 +3668,28 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'RMELTOC002' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'depth_to_water_table_from_surface',& + UNITS = 'm' ,& + SHORT_NAME = 'WATERTABLED' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FSWCHANGE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) VERIFY_(STATUS) + !EOS call MAPL_TimerAdd(GC, name="RUN1" ,RC=STATUS) @@ -4837,6 +4856,8 @@ subroutine Driver ( RC ) real, pointer, dimension(:) :: RMELTOC001 real, pointer, dimension(:) :: RMELTOC002 real, pointer, dimension(:) :: IRRIGRATE + real, pointer, dimension(:) :: WATERTABLED + real, pointer, dimension(:) :: FSWCHANGE ! -------------------------------------------------------------------------- ! Local pointers for tile variables @@ -5525,8 +5546,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,CNFUELC , 'CNFUELC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNTOTLITC , 'CNTOTLITC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNCWDC , 'CNCWDC' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNROOT , 'CNROOT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNFSEL, 'CNFSEL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNROOT , 'CNROOT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFSEL, 'CNFSEL' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTDU001,'RMELTDU001', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTDU002,'RMELTDU002', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTDU003,'RMELTDU003', RC=STATUS); VERIFY_(STATUS) @@ -5536,6 +5557,9 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,RMELTBC002,'RMELTBC002', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTOC001,'RMELTOC001', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTOC002,'RMELTOC002', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WATERTABLED,'WATERTABLED' RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWCHANGE, 'FSWCHANGE', RC=STATUS); VERIFY_(STATUS) + IF (RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) NTILES = size(PS) @@ -8035,6 +8059,10 @@ subroutine Driver ( RC ) if(associated(RMELTBC002)) RMELTBC002 = RMELT(:,7) if(associated(RMELTOC001)) RMELTOC001 = RMELT(:,8) if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) + if(associated(FSWCHANGE)) FSWCHANGE = FSW_CHANGE + if(associated(WATERTABLED)) then + WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) + endif if(associated(TPSN1OUT)) then where(WESNN(1,:)>0.) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 07e5e7ed8..8069fe150 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -2681,6 +2681,24 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'depth_to_water_table_from_surface',& + UNITS = 'm' ,& + SHORT_NAME = 'WATERTABLED' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& + UNITS = 'kg m-2 s-1' ,& + SHORT_NAME = 'FSWCHANGE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + !EOS call MAPL_TimerAdd(GC, name="INITIALIZE",RC=STATUS) @@ -3912,6 +3930,8 @@ subroutine Driver ( RC ) real, pointer, dimension(:) :: RMELTBC002 real, pointer, dimension(:) :: RMELTOC001 real, pointer, dimension(:) :: RMELTOC002 + real, pointer, dimension(:) :: WATERTABLED + real, pointer, dimension(:) :: FSWCHANGE ! -------------------------------------------------------------------------- ! Local pointers for tile variables @@ -4451,6 +4471,8 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,RMELTBC002,'RMELTBC002', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTOC001,'RMELTOC001', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,RMELTOC002,'RMELTOC002', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WATERTABLED,'WATERTABLED',RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWCHANGE, 'FSWCHANGE', RC=STATUS); VERIFY_(STATUS) NTILES = size(PS) @@ -5628,6 +5650,10 @@ subroutine Driver ( RC ) if(associated(RMELTBC002)) RMELTBC002 = RMELT(:,7) if(associated(RMELTOC001)) RMELTOC001 = RMELT(:,8) if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) + if(associated(FSWCHANGE )) FSWCHANGE = FSW_CHANGE + if(associated(WATERTABLED )) then + WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) + endif if(associated(TPSN1)) then where(WESNN(1,:)>0.) From f319d72f9e5080c6a29280a232b40b5cbbee4079 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 12:50:54 -0500 Subject: [PATCH 02/66] define FSW_CHANGE --- .../GEOS_CatchCNCLM40GridComp.F90 | 8 +++++--- .../GEOS_CatchCNCLM45GridComp.F90 | 8 +++++--- .../Shared/catchmentCN.F90 | 15 +++++++++++---- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 6 ++++-- .../GEOScatch_GridComp/catchment.F90 | 18 ++++++++++++++---- 5 files changed, 39 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index f40c286fe..f0c61251f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -4939,7 +4939,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: ghflxsno, ghflxtskin real,pointer,dimension(:) :: SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 real,pointer,dimension(:) :: LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW - real,pointer,dimension(:) :: TCSORIG1, TPSN1IN1, TPSN1OUT1 + real,pointer,dimension(:) :: TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE real,pointer,dimension(:) :: WCHANGE, ECHANGE, HSNACC, EVACC, SHACC real,pointer,dimension(:) :: SNOVR, SNOVF, SNONR, SNONF real,pointer,dimension(:) :: VSUVR, VSUVF @@ -5892,6 +5892,7 @@ subroutine Driver ( RC ) allocate(fveg2 (NTILES)) allocate(FICE1 (NTILES)) allocate(SLDTOT (NTILES)) + allocate(FSW_CHANGE(NTILES)) allocate(SHSBT (NTILES,NUM_SUBTILES)) allocate(DSHSBT (NTILES,NUM_SUBTILES)) @@ -7584,7 +7585,7 @@ subroutine Driver ( RC ) TSURF ,& SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 ,& LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW ,& - TCSORIG1, TPSN1IN1, TPSN1OUT1 ,& + TCSORIG1, TPSN1IN1, TPSN1OUT1,FSW_CHANGE ,& TC1_0=TC1_0, TC2_0=TC2_0, TC4_0=TC4_0 ,& QA1_0=QA1_0, QA2_0=QA2_0, QA4_0=QA4_0 ,& RCONSTIT=RCONSTIT, RMELT=RMELT, TOTDEPOS=TOTDEPOS, LHACC=LHACC) @@ -7996,7 +7997,8 @@ subroutine Driver ( RC ) deallocate(TOTDEPOS ) deallocate(RMELT ) deallocate(FICE1 ) - deallocate(SLDTOT ) + deallocate(SLDTOT ) + deallocate(FSW_CHANGE) deallocate( btran ) deallocate( wgt ) deallocate( bt1 ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 0bff5901b..133119f81 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -4886,7 +4886,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: ghflxsno, ghflxtskin real,pointer,dimension(:) :: SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 real,pointer,dimension(:) :: LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW - real,pointer,dimension(:) :: TCSORIG1, TPSN1IN1, TPSN1OUT1 + real,pointer,dimension(:) :: TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE real,pointer,dimension(:) :: WCHANGE, ECHANGE, HSNACC, EVACC, SHACC real,pointer,dimension(:) :: SNOVR, SNOVF, SNONR, SNONF real,pointer,dimension(:) :: VSUVR, VSUVF @@ -5888,6 +5888,7 @@ subroutine Driver ( RC ) allocate(fveg2 (NTILES)) allocate(FICE1 (NTILES)) allocate(SLDTOT (NTILES)) + allocate(FSW_CHANGE(NTILES)) allocate(SHSBT (NTILES,NUM_SUBTILES)) allocate(DSHSBT (NTILES,NUM_SUBTILES)) @@ -7830,7 +7831,7 @@ subroutine Driver ( RC ) TSURF ,& SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 ,& LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW ,& - TCSORIG1, TPSN1IN1, TPSN1OUT1 ,& + TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE ,& TC1_0=TC1_0, TC2_0=TC2_0, TC4_0=TC4_0 ,& QA1_0=QA1_0, QA2_0=QA2_0, QA4_0=QA4_0 ,& RCONSTIT=RCONSTIT, RMELT=RMELT, TOTDEPOS=TOTDEPOS, LHACC=LHACC) @@ -8247,7 +8248,8 @@ subroutine Driver ( RC ) deallocate(TOTDEPOS ) deallocate(RMELT ) deallocate(FICE1 ) - deallocate(SLDTOT ) + deallocate(SLDTOT ) + deallocate(FSW_CHANGE) deallocate( btran ) deallocate( wgt ) deallocate( bt1 ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 4f0434776..5247faef1 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -163,7 +163,7 @@ SUBROUTINE CATCHCN ( & EVACC, SHACC, TSURF, & SH_SNOW, AVET_SNOW, WAT_10CM, TOTWAT_SOIL, TOTICE_SOIL, & LH_SNOW, LWUP_SNOW, LWDOWN_SNOW, NETSW_SNOW, & - TCSORIG, TPSN1IN, TPSN1OUT, & + TCSORIG, TPSN1IN, TPSN1OUT,FSW_CHANGE, & TC1_0, TC2_0, TC4_0, QA1_0, QA2_0, QA4_0, EACC_0, & RCONSTIT, RMELT, TOTDEPOS, LHACC & ) @@ -225,11 +225,12 @@ SUBROUTINE CATCHCN ( & HSNACC, EVACC, SHACC REAL, INTENT(OUT), DIMENSION(:) :: GHFLUXSNO, GHTSKIN - REAL, INTENT(OUT), DIMENSION(:) :: SH_SNOW, AVET_SNOW, & + REAL, INTENT(OUT), DIMENSION(:) :: SH_SNOW, AVET_SNOW, & WAT_10CM, TOTWAT_SOIL, TOTICE_SOIL - REAL, INTENT(OUT), DIMENSION(:) :: LH_SNOW, LWUP_SNOW, & + REAL, INTENT(OUT), DIMENSION(:) :: LH_SNOW, LWUP_SNOW, & LWDOWN_SNOW, NETSW_SNOW - REAL, INTENT(OUT), DIMENSION(:) :: TCSORIG, TPSN1IN, TPSN1OUT + REAL, INTENT(OUT), DIMENSION(:) :: TCSORIG, TPSN1IN, TPSN1OUT, & + FSW_CHANGE REAL, INTENT(OUT), DIMENSION(:), OPTIONAL :: LHACC @@ -1271,6 +1272,12 @@ SUBROUTINE CATCHCN ( & WCHANGE(N) = (WTOT(N)-WTOT_ORIG(N))/DTSTEP ECHANGE(N) = (ENTOT(N)-ENTOT_ORIG(N))/DTSTEP + !FSW_CHANGE IS THE CHANGE IN THE FREE-STANDING WATER, RELEVANT FOR PEATLAND ONLY + FSW_CHANGE(N) = 0. + IF(POROS(N) >= POROS_HighLat) THEN + pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) + FSW_CHANGE(N) = PR - EVAP(N) - RUNOFF(N) - WCHANGE(N) + ENDIF ! Perform check on sum of AR1 and AR2, to avoid calculation of negative ! wilting fraction due to roundoff, outside of catchment: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 8069fe150..1de117075 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -3960,7 +3960,7 @@ subroutine Driver ( RC ) real,pointer,dimension(:) :: ghflxsno, ghflxtskin real,pointer,dimension(:) :: SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 real,pointer,dimension(:) :: LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW - real,pointer,dimension(:) :: TCSORIG1, TPSN1IN1, TPSN1OUT1 + real,pointer,dimension(:) :: TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE real,pointer,dimension(:) :: WCHANGE, ECHANGE, HSNACC, EVACC, SHACC real,pointer,dimension(:) :: SNOVR, SNOVF, SNONR, SNONF real,pointer,dimension(:) :: VSUVR, VSUVF @@ -4541,6 +4541,7 @@ subroutine Driver ( RC ) allocate(SUMEV (NTILES)) allocate(FICE1 (NTILES)) allocate(SLDTOT (NTILES)) ! total solid precip + allocate(FSW_CHANGE(NTILES)) allocate(SHSBT (NTILES,NUM_SUBTILES)) allocate(DSHSBT (NTILES,NUM_SUBTILES)) @@ -5465,7 +5466,7 @@ subroutine Driver ( RC ) ENTOT,WTOT, WCHANGE, ECHANGE, HSNACC, EVACC, SHACC ,& SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 ,& LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW ,& - TCSORIG1, TPSN1IN1, TPSN1OUT1 ,& + TCSORIG1, TPSN1IN1, TPSN1OUT1,FSW_CHANGE ,& lonbeg,lonend,latbeg,latend ,& TC1_0=TC1_0, TC2_0=TC2_0, TC4_0=TC4_0 ,& QA1_0=QA1_0, QA2_0=QA2_0, QA4_0=QA4_0 ,& @@ -5817,6 +5818,7 @@ subroutine Driver ( RC ) deallocate(RMELT ) deallocate(FICE1 ) deallocate(SLDTOT ) + deallocate(FSW_CHANGE) RETURN_(ESMF_SUCCESS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 067d467b4..15d69b26b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -151,7 +151,8 @@ SUBROUTINE CATCHMENT ( & EVACC, SHACC, & SH_SNOW, AVET_SNOW, WAT_10CM, TOTWAT_SOIL, TOTICE_SOIL, & LH_SNOW, LWUP_SNOW, LWDOWN_SNOW, NETSW_SNOW, & - TCSORIG, TPSN1IN, TPSN1OUT,lonbeg,lonend,latbeg,latend, & + TCSORIG, TPSN1IN, TPSN1OUT,FSW_CHANGE , & + lonbeg,lonend,latbeg,latend, & TC1_0, TC2_0, TC4_0, QA1_0, QA2_0, QA4_0, EACC_0, & RCONSTIT, RMELT, TOTDEPOS, LHACC) @@ -212,11 +213,12 @@ SUBROUTINE CATCHMENT ( & HSNACC, EVACC, SHACC REAL, INTENT(OUT), DIMENSION(NCH) :: GHFLUXSNO, GHTSKIN - REAL, INTENT(OUT), DIMENSION(NCH) :: SH_SNOW, AVET_SNOW, & + REAL, INTENT(OUT), DIMENSION(NCH) :: SH_SNOW, AVET_SNOW, & WAT_10CM, TOTWAT_SOIL, TOTICE_SOIL - REAL, INTENT(OUT), DIMENSION(NCH) :: LH_SNOW, LWUP_SNOW, & + REAL, INTENT(OUT), DIMENSION(NCH) :: LH_SNOW, LWUP_SNOW, & LWDOWN_SNOW, NETSW_SNOW - REAL, INTENT(OUT), DIMENSION(NCH) :: TCSORIG, TPSN1IN, TPSN1OUT + REAL, INTENT(OUT), DIMENSION(NCH) :: TCSORIG, TPSN1IN, TPSN1OUT, & + FSW_CHANGE REAL, INTENT(OUT), DIMENSION(NCH), OPTIONAL :: LHACC @@ -1283,6 +1285,14 @@ SUBROUTINE CATCHMENT ( & WCHANGE(N) = (WTOT(N)-WTOT_ORIG(N))/DTSTEP ECHANGE(N) = (ENTOT(N)-ENTOT_ORIG(N))/DTSTEP + !FSW_CHANGE IS THE CHANGE IN THE FREE-STANDING WATER, RELEVANT FOR PEATLAND ONLY + FSW_CHANGE(N) = 0. + IF(POROS(N) >= POROS_HighLat) THEN + pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) + FSW_CHANGE(N) = PR - EVAP(N) - RUNOFF(N) - WCHANGE(N) + ENDIF + + ! Perform check on sum of AR1 and AR2, to avoid calculation of negative ! wilting fraction due to roundoff, outside of catchment: From d939ed6736b18941b5bd61d033a31f0161c930b9 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 14:08:11 -0500 Subject: [PATCH 03/66] add peat source code "POROS_HighLat" --- .../Shared/catchmentCN.F90 | 91 ++++- .../GEOScatch_GridComp/catchment.F90 | 108 +++++- .../Shared/catch_constants.f90 | 2 + .../GEOSland_GridComp/Shared/lsm_routines.F90 | 317 ++++++++++++++---- 4 files changed, 426 insertions(+), 92 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 5247faef1..80c784876 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -87,7 +87,7 @@ MODULE CATCHMENT_CN_MODEL SLOPE => CATCH_SNWALB_SLOPE, & MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & - SHR, SCONST, C_CANOP, N_sm, SATCAPFR + SHR, SCONST, C_CANOP, N_sm, SATCAPFR , POROS_HighLat USE SURFPARAMS, ONLY: CSOIL_2, RSWILT, & LAND_FIX, FLWALPHA @@ -1735,23 +1735,79 @@ SUBROUTINE RZDRAIN ( & IF (CATDEF(N)-RZFLW .GT. CDCR2(N)) then RZFLW=CATDEF(N)-CDCR2(N) - end if + end if - CATDEF(N)=CATDEF(N)-RZFLW - RZEXC(N)=RZEXC(N)-RZFLW + IF (POROS(N) < POROS_HighLat) THEN + CATDEF(N)=CATDEF(N)-RZFLW + RZEXC(N)=RZEXC(N)-RZFLW + ELSE + !MB2021: use AR1eq, equilibrium assumption between water level in soil hummocks and surface water level in hollows + AR1eq = (1+ars1(n)*(catdef(n)))/(1+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) + ! PEAT + ! MB: accounting for water ponding on AR1 + ! RZFLOW is partitioned into two flux components: (1) going in/out ponding water volume and (1) going in/out unsaturated soil storage + ! Specific yield of ponding water surface fraction is 1.0 + ! calculate SYSOIL (see Dettmann and Bechtold, VZJ, 2016, for detailed theory) + ! SYSOIL in CLSM can be derived from first derivative of + ! f_catdef(zbar) = ((zbar + bf2)^2 +1.0E-20)*bf1 + ! division by 1000 to convert from m to mm gives (Note: catdef in PEATCLSM remains + ! the soil profile deficit, i.e. does not include the ponding water storage). + ! SYSOIL = (2*bf1*zbar + 2*bf1*bf2)/1000 + ! Note: zbar defined here positive below ground. + ! For the SYSOIL estimation zbar must be constrained to 0.0 to 0.45 m, + ! to avoid extrapolation errors due to the non-optimal + ! (linear) approximation with the bf1-bf2-CLSM function, + ! theoretical SYSOIL curve levels off approximately at 0 m and 0.45 m. + ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + SYSOIL = (2*bf1(n)*amin1(amax1(zbar1,0.),0.45) + 2*bf1(n)*bf2(n))/1000. + ! Calculate fraction of RZFLW removed/added to catdef + RZFLW_CATDEF = (1-AR1eq)*SYSOIL*RZFLW/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + CATDEF(N)=CATDEF(N)-RZFLW_CATDEF + ! MB: remove all RZFLW from RZEXC because the other part + ! flows into the surface water storage (microtopgraphy) + RZEXC(N)=RZEXC(N)-RZFLW + + ENDIF !**** REMOVE ANY EXCESS FROM MOISTURE RESERVOIRS: IF(CAPAC(N) .GT. SATCAP(N)) THEN RZEXC(N)=RZEXC(N)+CAPAC(N)-SATCAP(N) CAPAC(N)=SATCAP(N) - ENDIF + ENDIF IF(RZEQ(N) + RZEXC(N) .GT. VGWMAX(N)) THEN EXCESS=RZEQ(N)+RZEXC(N)-VGWMAX(N) RZEXC(N)=VGWMAX(N)-RZEQ(N) - CATDEF(N)=CATDEF(N)-EXCESS + + IF (POROS(N) < POROS_HighLat) THEN + CATDEF(N)=CATDEF(N)-EXCESS + ELSE + ! PEAT + ! MB: like for RZFLW --> EXCESS_CATDEF is the fraction in/out of catdef + EXCESS_CATDEF=(1-AR1eq)*SYSOIL*EXCESS/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + CATDEF(N)=CATDEF(N)-EXCESS_CATDEF ENDIF + ENDIF + + IF (POROS(N) >= POROS_HighLat) THEN + ! MB: CATDEF Threshold at zbar=0 + ! water table not allowed to rise higher (numerically instable) + ! zbar<0 only occurred due to extreme infiltration rates + ! (noticed this only snow melt events, very few locations and times) + ! (--> NOTE: PEATCLSM has no Hortonian runoff for zbar > 0) + CATDEF_PEAT_THRESHOLD = ((BF2(N))**2.0-1.e-20)*BF1(N) + IF(CATDEF(N) .LT. CATDEF_PEAT_THRESHOLD) THEN + RUNSRF(N)=RUNSRF(N) + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) + ! runoff from AR1 for zbar>0 + RZFLW_AR1 = RZFLW - RZFLW_CATDEF + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) + ! AR1=0.5 at zbar=0 + ! SYsurface=0.5 at zbar=0 + RUNSRF(N) = RUNSRF(N) + amax1(0.0, RZFLW_AR1 - 0.5*1000.*ZBAR1) + ! + CATDEF(N)=CATDEF_PEAT_THRESHOLD + ENDIF + ENDIF IF(CATDEF(N) .LT. 0.) THEN RUNSRF(N)=RUNSRF(N)-CATDEF(N) @@ -2344,17 +2400,30 @@ SUBROUTINE WUPDAT ( & !**** REMOVE MOISTURE FROM RESERVOIRS: !**** - IF (CATDEF(N) .LT. CDCR1(N)) THEN + IF (CATDEF(N) .LT. CDCR1(N)) THEN CAPAC(N) = AMAX1(0., CAPAC(N) - EVINT(N)*DTSTEP) RZEXC(N) = RZEXC(N) - EVROOT(N)*(1.-ESATFR(N))*DTSTEP SRFEXC(N) = SRFEXC(N) - EVSURF(N)*(1.-ESATFR(N))*DTSTEP - CATDEF(N) = CATDEF(N) + (EVSURF(N) + EVROOT(N))*ESATFR(N)*DTSTEP -! 05.12.98: FIRST ATTEMPT TO INCLUDE BEDROCK - ELSE + IF (POROS(N) < POROS_HighLat) THEN + CATDEF(N) = CATDEF(N) + (EVSURF(N) + EVROOT(N))*ESATFR(N)*DTSTEP + ! 05.12.98: FIRST ATTEMPT TO INCLUDE BEDROCK + ELSE + ! PEAT + ! MB: accounting for water ponding on AR1 + ! same approach as for RZFLW (see subroutine RZDRAIN for + ! comments) + ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + SYSOIL = (2*bf1(N)*amin1(amax1(zbar1,0.),0.45) + 2*bf1(N)*bf2(N))/1000. + SYSOIL = amin1(SYSOIL,poros(N)) + ET_CATDEF = SYSOIL*(EVSURF(N) + EVROOT(N))*ESATFR(N)/(1.0*AR1(N)+SYSOIL*(1-AR1(N))) + AR1eq = (1+ars1(N)*(catdef(N)))/(1+ars2(N)*(catdef(N))+ars3(N)*(catdef(N))**2) + CATDEF(N) = CATDEF(N) + (1-AR1eq)*ET_CATDEF + ENDIF + ELSE CAPAC(N) = AMAX1(0., CAPAC(N) - EVINT(N)*DTSTEP) RZEXC(N) = RZEXC(N) - EVROOT(N)*DTSTEP SRFEXC(N) = SRFEXC(N) - EVSURF(N)*DTSTEP - ENDIF + ENDIF !**** 100 CONTINUE diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 15d69b26b..c39434cc1 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -87,7 +87,7 @@ MODULE CATCHMENT_MODEL SLOPE => CATCH_SNWALB_SLOPE, & MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & - SHR, SCONST, CSOIL_1, N_sm, SATCAPFR + SHR, SCONST, CSOIL_1, N_sm, SATCAPFR, POROS_HighLat USE SURFPARAMS, ONLY: & LAND_FIX, ASTRFR, STEXP, RSWILT, & @@ -1292,8 +1292,6 @@ SUBROUTINE CATCHMENT ( & FSW_CHANGE(N) = PR - EVAP(N) - RUNOFF(N) - WCHANGE(N) ENDIF - - ! Perform check on sum of AR1 and AR2, to avoid calculation of negative ! wilting fraction due to roundoff, outside of catchment: IF(AR1(N)+AR2(N) .GT. 1.) THEN @@ -1775,28 +1773,91 @@ SUBROUTINE RZDRAIN ( & IF (CATDEF(N)-RZFLW .GT. CDCR2(N)) then RZFLW=CATDEF(N)-CDCR2(N) - end if + end if - CATDEF(N)=CATDEF(N)-RZFLW - RZEXC(N)=RZEXC(N)-RZFLW + IF (POROS(N) < POROS_HighLat) then + ! mineral soil + CATDEF(N)=CATDEF(N)-RZFLW + RZEXC(N)=RZEXC(N)-RZFLW + else + !MB2021: use AR1eq, equilibrium assumption between water level in soil hummocks and surface water level in hollows + AR1eq = (1+ars1(n)*(catdef(n)))/(1+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) + ! PEAT + ! MB: accounting for water ponding on AR1 + ! RZFLOW is partitioned into two flux components: (1) going in/out ponding water volume and (1) going in/out unsaturated soil storage + ! Specific yield of ponding water surface fraction is 1.0 + ! calculate SYSOIL (see Dettmann and Bechtold, VZJ, 2016, for detailed theory) + ! SYSOIL in CLSM can be derived from first derivative of + ! f_catdef(zbar) = ((zbar + bf2)^2 +1.0E-20)*bf1 + ! division by 1000 to convert from m to mm gives (Note: catdef in PEATCLSM remains + ! the soil profile deficit, i.e. does not include the ponding water storage). + ! SYSOIL = (2*bf1*zbar + 2*bf1*bf2)/1000 + ! Note: zbar defined here positive below ground. + ! For the SYSOIL estimation zbar must be constrained to 0.0 to 0.45 m, + ! to avoid extrapolation errors due to the non-optimal + ! (linear) approximation with the bf1-bf2-CLSM function, + ! theoretical SYSOIL curve levels off approximately at 0 m and 0.45 m. + ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + SYSOIL = (2*bf1(n)*amin1(amax1(zbar1,0.),0.45) + 2*bf1(n)*bf2(n))/1000. + SYSOIL = amin1(SYSOIL,poros(n)) + ! Calculate fraction of RZFLW removed/added to catdef + RZFLW_CATDEF = (1-AR1eq)*SYSOIL*RZFLW/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + CATDEF(N)=CATDEF(N)-RZFLW_CATDEF + ! MB: remove all RZFLW from RZEXC because the other part + ! flows into the surface water storage (microtopgraphy) + RZEXC(N)=RZEXC(N)-RZFLW + + ENDIF + !**** REMOVE ANY EXCESS FROM MOISTURE RESERVOIRS: IF(CAPAC(N) .GT. SATCAP(N)) THEN RZEXC(N)=RZEXC(N)+CAPAC(N)-SATCAP(N) CAPAC(N)=SATCAP(N) - ENDIF + ENDIF IF(RZEQ(N) + RZEXC(N) .GT. VGWMAX(N)) THEN EXCESS=RZEQ(N)+RZEXC(N)-VGWMAX(N) RZEXC(N)=VGWMAX(N)-RZEQ(N) - CATDEF(N)=CATDEF(N)-EXCESS + + IF (POROS(N) < POROS_HighLat) THEN + CATDEF(N)=CATDEF(N)-EXCESS + ELSE + ! PEAT + ! MB: like for RZFLW --> EXCESS_CATDEF is the fraction in/out of catdef + EXCESS_CATDEF=(1-AR1eq)*SYSOIL*EXCESS/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + CATDEF(N)=CATDEF(N)-EXCESS_CATDEF ENDIF + ENDIF - IF(CATDEF(N) .LT. 0.) THEN + IF (POROS(N) >= POROS_HighLat) THEN + ! MB: CATDEF Threshold at zbar=0 + ! water table not allowed to rise higher (numerically instable) + ! zbar<0 only occurred due to extreme infiltration rates + ! (noticed this only snow melt events, very few locations and times) + ! (--> NOTE: PEATCLSM has no Hortonian runoff for zbar > 0) + CATDEF_PEAT_THRESHOLD = ((BF2(N))**2.0-1.e-20)*BF1(N) + IF(CATDEF(N) .LT. CATDEF_PEAT_THRESHOLD) THEN + ! RUNSRF(N)=RUNSRF(N) + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) + ! runoff from AR1 for zbar>0 + ! RZFLW_AR1 = RZFLW - RZFLW_CATDEF + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) + ! AR1=0.5 at zbar=0 + ! SYsurface=0.5 at zbar=0 + ! RUNSRF(N) = RUNSRF(N) + amax1(0.0, RZFLW_AR1 - 0.5*1000.*ZBAR1) + ! + ! revised (rdk, 1/04/2021): take excess water from both + ! soil and free standing water, the latter assumed to cover area AR1=0.5 + RUNSRF(N) = RUNSRF(N) + CATDEF_PEAT_THRESHOLD-CATDEF(N) + 0.5*1000.*(-ZBAR1) + + CATDEF(N)=CATDEF_PEAT_THRESHOLD + ENDIF + ENDIF + + IF(CATDEF(N) .LT. 0.) THEN RUNSRF(N)=RUNSRF(N)-CATDEF(N) CATDEF(N)=0. - ENDIF + ENDIF 100 ENDDO @@ -1970,6 +2031,15 @@ SUBROUTINE energy1 ( & DEDEA(CHNO) = DEDQA(CHNO) * EPSILON / PSUR(CHNO) DHSDEA(CHNO) = DHSDQA(CHNO) * EPSILON / PSUR(CHNO) + IF (POROS(CHNO) < POROS_HighLat) THEN + ! mineral soil + SWSRF4(CHNO) = SWSRF(CHNO) + ELSE + ! PEAT + ! MB: For ET calculation, AR4 surface wetness is set to WPWET + SWSRF4(CHNO) = WPWET(CHNO) + ENDIF + 100 CONTINUE !**** @@ -2840,11 +2910,25 @@ SUBROUTINE WUPDAT ( & !**** REMOVE MOISTURE FROM RESERVOIRS: !**** - IF (CATDEF(CHNO) .LT. CDCR1(CHNO)) THEN + IF (CATDEF(CHNO) .LT. CDCR1(CHNO)) THEN CAPAC(CHNO) = AMAX1(0., CAPAC(CHNO) - EINT(CHNO)) RZEXC(CHNO) = RZEXC(CHNO) - EVEG(CHNO)*(1.-ESATFR) SRFEXC(CHNO) = SRFEXC(CHNO) - ESOI(CHNO)*(1.-ESATFR) - CATDEF(CHNO) = CATDEF(CHNO) + (ESOI(CHNO) + EVEG(CHNO))*ESATFR + + IF (POROS(CHNO) < POROS_HighLat) THEN + CATDEF(CHNO) = CATDEF(CHNO) + (ESOI(CHNO) + EVEG(CHNO))*ESATFR + ELSE + ! PEAT + ! MB: accounting for water ponding on AR1 + ! same approach as for RZFLW (see subroutine RZDRAIN for + ! comments) + ZBAR1=SQRT(1.e-20+CATDEF(CHNO)/BF1(CHNO))-BF2(CHNO) + SYSOIL = (2*bf1(CHNO)*amin1(amax1(zbar1,0.),0.45) + 2*bf1(CHNO)*bf2(CHNO))/1000. + SYSOIL = amin1(SYSOIL,poros(CHNO)) + ET_CATDEF = SYSOIL*(ESOI(CHNO) + EVEG(CHNO))*ESATFR/(1.0*AR1(CHNO)+SYSOIL*(1-AR1(CHNO))) + AR1eq = (1+ars1(chno)*(catdef(chno)))/(1+ars2(chno)*(catdef(chno))+ars3(chno)*(catdef(chno))**2) + CATDEF(CHNO) = CATDEF(CHNO) + (1-AR1eq)*ET_CATDEF + ENDIF ! 05.12.98: first attempt to include bedrock ELSE CAPAC(CHNO) = AMAX1(0., CAPAC(CHNO) - EINT(CHNO)) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 index 93b168c92..06c7c1e8f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 @@ -84,6 +84,8 @@ module catch_constants REAL, PARAMETER, PUBLIC :: C_CANOP = 200. ! J/K - heat capacity associated w/ tc REAL, PARAMETER, PUBLIC :: SATCAPFR = 0.2 ! SATCAP = SATCAPFR * LAI + ! peatCLSM implementation smahanam 3-16-2021 + REAL, PARAMETER, PUBLIC :: POROS_HighLat = 0.9 end module catch_constants diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 85d4f8412..aa3b6b8d8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -48,7 +48,7 @@ MODULE lsm_routines MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & SHR, N_SM, SCONST, CSOIL_1, & - C_CANOP, SATCAPFR + C_CANOP, SATCAPFR, POROS_HighLat USE SURFPARAMS, ONLY: & LAND_FIX, CSOIL_2, WEMIN, AICEV, AICEN, & @@ -290,67 +290,176 @@ SUBROUTINE SRUNOFF ( & DO N=1,NCH if(.not.UFW4RO) then - + PTOTAL=THRUL(N) + THRUC(N) - frun=AR1(N) - srun0=PTOTAL*frun - - !**** Comment out this line in order to allow moisture - !**** to infiltrate soil: - ! if(tp1(n) .lt. 0.) srun0=ptotal - - if(ptotal-srun0 .gt. srfmx(n)-srfexc(n)) & - srun0=ptotal-(srfmx(n)-srfexc(n)) - - if (srun0 .gt. ptotal) srun0=ptotal - - RUNSRF(N)=RUNSRF(N)+srun0 - QIN=PTOTAL-srun0 - + + IF (POROS(N) < POROS_HighLat) THEN + ! Non-peatland + frun=AR1(N) + srun0=PTOTAL*frun + + !**** Comment out this line in order to allow moisture + !**** to infiltrate soil: + ! if(tp1(n) .lt. 0.) srun0=ptotal + + if(ptotal-srun0 .gt. srfmx(n)-srfexc(n)) & + srun0=ptotal-(srfmx(n)-srfexc(n)) + + if (srun0 .gt. ptotal) srun0=ptotal + + RUNSRF(N)=RUNSRF(N)+srun0 + QIN=PTOTAL-srun0 + SRFEXC(N)=SRFEXC(N)+QIN + ELSE + ! Peatland + ! MB: no Hortonian surface runoff + !Note (rdk, from discussion w/MB; email 01/04/2021): + ! forcing all the rain to fall onto + ! the soil (1-AR1 fraction) rather than + ! onto both the soil and the free water surface is a simple shortcut; + ! the key function of this code is to retain all rainwater in the system + ! and *only* to produce surface runoff when the + ! ground is already ridiculously wet. + ! This prevents problems (e.g., numerical instabilities) found in + ! discharge calculations elsewhere in the code. + + srun0 = 0. + ! handling numerical instability due to exceptional snow melt events at some pixels + ! avoid AR1 to increase much higher than > 0.5 by enabling runoff + !Added ramping to avoid potential oscillations (rdk, 09/18/20) + IF (AR1(N)>0.50) srun0=PTOTAL*amin1(1.,(ar1(n)-0.5)/0.1) + + ! MB: even no surface runoff when srfmx is exceeded (activating macro-pore flow) + ! Rewrote code to determine excess over capacity all at once (rdk, 09/18/20) + + totcapac=(srfmx(n)-srfexc(n))+(vgwmax(n)-(rzeq(n)+rzexc(n))) + watadd=ptotal-srun0 + if (watadd .gt. totcapac) then + excess=watadd-totcapac + srun0=srun0+excess + srfexc(n)=srfmx(n) + rzexc(n)=vgwmax(n)-rzeq(n) + elseif(watadd .gt. srfmx(n)-srfexc(n)) then + excess=watadd-(srfmx(n)-srfexc(n)) + srfexc(n)=srfmx(n) + rzexc(n)=rzexc(n)+excess + else + srfexc(n)=srfexc(n)+watadd + endif + ! MB: check if VGWMAX is exceeded + !IF(RZEQ(N) + RZEXC(N) .GT. (VGWMAX(N))) THEN + ! srun0 = srun0 + RZEQ(N)+RZEXC(N)-VGWMAX(N) + ! RZEXC(N)=VGWMAX(N)-RZEQ(N) + ! ENDIF + !(Commented out following lines to retain water balance -- rdk, 9/18/20) + !if (srun0 .gt. ptotal) then + ! srun0=ptotal + ! endif + RUNSRF(N)=RUNSRF(N)+srun0 + QIN=PTOTAL-srun0 + !SRFEXC(N)=amin1(SRFEXC(N)+QIN,srfmx(n)) + ENDIF + endif if(UFW4RO) then !**** Compute runoff from large-scale and convective storms separately: - - deficit=srfmx(n)-srfexc(n) - srunl=AR1(n)*THRUL(n) - qinfil_l=(1.-ar1(n))*THRUL(n) - qcapac=deficit*FWETL - - if(qinfil_l .gt. qcapac) then - excess_infil=qinfil_l-qcapac - srunl=srunl+excess_infil - qinfil_l=qinfil_l-excess_infil - endif - - srunc=AR1(n)*THRUC(n) - qinfil_c=(1.-ar1(n))*THRUC(n) - qcapac=deficit*FWETC - - if(qinfil_c .gt. qcapac) then - excess_infil=qinfil_c-qcapac - srunc=srunc+excess_infil - qinfil_c=qinfil_c-excess_infil + IF (POROS(N) < POROS_HighLat) THEN + !non-peatland + deficit=srfmx(n)-srfexc(n) + srunl=AR1(n)*THRUL(n) + qinfil_l=(1.-ar1(n))*THRUL(n) + qcapac=deficit*FWETL + + if(qinfil_l .gt. qcapac) then + excess_infil=qinfil_l-qcapac + srunl=srunl+excess_infil + qinfil_l=qinfil_l-excess_infil + endif + + srunc=AR1(n)*THRUC(n) + qinfil_c=(1.-ar1(n))*THRUC(n) + qcapac=deficit*FWETC + + if(qinfil_c .gt. qcapac) then + excess_infil=qinfil_c-qcapac + srunc=srunc+excess_infil + qinfil_c=qinfil_c-excess_infil + endif + + !**** Comment out this line in order to allow moisture + !**** to infiltrate soil: + ! if(tp1(n) .lt. 0.) srun0=ptotal + + if (srunl .gt. THRUL(n)) srunl=THRUL(n) + + if (srunc .gt. THRUC(n)) srunc=THRUC(n) + + RUNSRF(N)=RUNSRF(N)+srunl+srunc + QIN=THRUL(n)+THRUC(n)-(srunl+srunc) + SRFEXC(N)=SRFEXC(N)+QIN + + else + ! peatland + ! MB: no Hortonian surface runoff + !Note (rdk, from discussion w/MB; email 01/04/2021): + ! forcing all the rain to fall onto + ! the soil (1-AR1 fraction) rather than + ! onto both the soil and the free water surface is a simple shortcut; + ! the key function of this code is to retain all rainwater in the system + ! and *only* to produce surface runoff when the + ! ground is already ridiculously wet. + ! This prevents problems (e.g., numerical instabilities) found in + ! discharge calculations elsewhere in the code. + + srunl = 0. + srunc = 0. + ! handling numerical instability due to exceptional snow melt events at some pixels + ! avoid AR1 to increase much higher than > 0.5 by enabling runoff + IF (AR1(N)>0.50) THEN + !Added ramping to avoid potential oscillations (rdk, 09/18/20) + srunl = THRUL(n)*amin1(1.,(ar1(n)-0.5)/0.1) + srunc = THRUC(n)*amin1(1.,(ar1(n)-0.5)/0.1) + ENDIF + PTOTAL = THRUL(N) + THRUC(N) + SRUN0 = srunl + srunc + ! MB: even no surface runoff when srfmx is exceeded (activating macro-pore flow) + ! Rewrote code to determine excess over capacity all at once (rdk, 09/18/20) + totcapac=(srfmx(n)-srfexc(n))+(vgwmax(n)-(rzeq(n)+rzexc(n))) + watadd=ptotal-srun0 + if (watadd .gt. totcapac) then + excess=watadd-totcapac + srun0=srun0+excess + srfexc(n)=srfmx(n) + rzexc(n)=vgwmax(n)-rzeq(n) + elseif(watadd .gt. srfmx(n)-srfexc(n)) then + excess=watadd-(srfmx(n)-srfexc(n)) + srfexc(n)=srfmx(n) + rzexc(n)=rzexc(n)+excess + else + srfexc(n)=srfexc(n)+watadd + endif + !if (ptotal-srun0 .gt. srfmx(n)-srfexc(n)) then + ! excess=(ptotal-srun0)-(srfmx(n)-srfexc(n)) + ! rzexc(n)=rzexc(n) + excess + ! ptotal=ptotal-excess + ! endif + ! MB: check if VGWMAX is exceeded + !IF(RZEQ(N) + RZEXC(N) .GT. (VGWMAX(N))) THEN + ! srun0 = srun0 + RZEQ(N)+RZEXC(N)-VGWMAX(N) + ! RZEXC(N)=VGWMAX(N)-RZEQ(N) + ! ENDIF + RUNSRF(N)=RUNSRF(N)+srun0 + QIN=PTOTAL-srun0 + ! SRFEXC(N)=amin1(SRFEXC(N)+QIN,srfmx(n)) endif - - !**** Comment out this line in order to allow moisture - !**** to infiltrate soil: - ! if(tp1(n) .lt. 0.) srun0=ptotal - - if (srunl .gt. THRUL(n)) srunl=THRUL(n) - - if (srunc .gt. THRUC(n)) srunc=THRUC(n) - - RUNSRF(N)=RUNSRF(N)+srunl+srunc - QIN=THRUL(n)+THRUC(n)-(srunl+srunc) endif - SRFEXC(N)=SRFEXC(N)+QIN RUNSRF(N)=RUNSRF(N)/DTSTEP QINFIL(N)=QIN/DTSTEP - + END DO RETURN @@ -385,25 +494,64 @@ SUBROUTINE BASE ( & data ashift/0./ - - DO N=1,NCH + DO N=1,NCH ! note intentionally opposite sign w.r.t. zbar defined above, - reichle, 16 Nov 2015 - ZBAR=SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) - BFLOW(N)=(1.-FRICE(N))*1000.* & - cond(n)*exp(-(bf3(n)-ashift)-gnu(n)*zbar)/gnu(n) -! *1000 is to convert from m/s to mm/s - IF (CATDEF(N) .GE. CDCR1(N)) BFLOW(N)=0. -!#ifdef LAND_UPD - IF (LAND_FIX) THEN - bflow(n)=amin1(1000.*cond(n),bflow(n)) - ELSE -!#else - bflow(n)=amin1(cond(n),bflow(n)) - END IF -!#endif - CATDEF(N)=CATDEF(N)+BFLOW(N)*dtstep - ENDDO + ZBAR=SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) + IF (POROS(N) < POROS_HighLat) THEN + BFLOW(N)=(1.-FRICE(N))*1000.* & + cond(n)*exp(-(bf3(n)-ashift)-gnu(n)*zbar)/gnu(n) + ! *1000 is to convert from m/s to mm/s + IF (CATDEF(N) .GE. CDCR1(N)) BFLOW(N)=0. + !#ifdef LAND_UPD + IF (LAND_FIX) THEN + bflow(n)=amin1(1000.*cond(n),bflow(n)) + ELSE + !#else + bflow(n)=amin1(cond(n),bflow(n)) + END IF + !#endif + CATDEF(N)=CATDEF(N)+BFLOW(N)*dtstep + ELSE + ! PEAT + ! MB: + IF (FRICE(N) .GE. 0.9999) THEN + CFRICE = 1. + ELSE + CFRICE = FRICE(N) + ENDIF + ! BFLOW in mm/s + ! based on Ivanov 1981 + ! Ksz0 in m/s + ! m_Ivanov [-] value depends on unit of Ksz0 and z + ! v_slope in m^(-1) + Ksz_zero=10. + m_Ivanov=3.0 + v_slope = 1.5e-05 + ! Ta in m2/s, BFLOW in mm/s + Ta = (Ksz_zero*(1.+100.*amax1(0.,ZBAR))**(1.-m_Ivanov))/(100.*(m_Ivanov-1.)) + BFLOW(N)=v_slope*Ta*1000. + ! handling numerical instability due to extrene snow melt events on partly frozen ground + ! --> allow BFLOW/DISCHARGE for zbar .LE. 0.05 + ICERAMP= AMAX1(0., AMIN1(1., ZBAR/0.05)) + ICERAMP= 1.-ICERAMP*CFRICE + BFLOW(N)=ICERAMP*BFLOW(N) + + ! MB: Remove water from CATDEF and surface water storage + IF (BFLOW(N) .NE. 0.0) THEN + ! PEAT + ! MB: accounting for water ponding on AR1 + ! same approach as for RZFLW (see subroutine RZDRAIN for + ! comments) + SYSOIL = (2*bf1(N)*amin1(amax1(zbar,0.),0.45) + 2*bf1(N)*bf2(N))/1000. + SYSOIL = amin1(SYSOIL,poros(n)) + !MB2021: use AR1eq, equilibrium assumption between water level in soil hummocks and surface water level in hollows + AR1eq = (1+ars1(n)*(catdef(n)))/(1+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) + BFLOW_CATDEF = (1-AR1eq)*SYSOIL*BFLOW(N)/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + CATDEF(N)=CATDEF(N)+BFLOW_CATDEF*dtstep + ENDIF + ENDIF + ENDDO RETURN END SUBROUTINE BASE @@ -589,10 +737,22 @@ SUBROUTINE PARTITION ( & ENDIF + IF (POROS(N) >= POROS_HighLat) THEN + ! peat + ! MB: AR4 (wilting fraction) for peatland depending on water table depth + !ZBAR defined here positive below ground and in meter + ZBAR=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + AR4(N)=amax1(0.,amin1(1.0,(ZBAR-0.30)/(1.0))) + ARREST = 1.0 - AR1(N) + AR4(N)=amin1(ARREST,AR4(N)) + AR2(N)=1.0-AR4(n)-AR1(N) + ENDIF + RZI(N)=RZEQYI SWSRF1(N)=1. !mjs: changed .001 temporarily because of large bee. + IF (POROS(N) < POROS_HighLat) THEN SWSRF2(N)=AMIN1(1., AMAX1(0.01, RZEQYI)) SWSRF4(N)=AMIN1(1., AMAX1(0.01, WILT)) @@ -604,6 +764,18 @@ SUBROUTINE PARTITION ( & SWSRF2(N)=((SWSRF2(N)**(-BEE(N))) - (.5/PSIS(N)))**(-1./BEE(N)) SWSRF4(N)=((SWSRF4(N)**(-BEE(N))) - (.5/PSIS(N)))**(-1./BEE(N)) + ELSE + + ! PEAT + ! MB: for peatlands integrate across surface soil moisture distribution + ! coefficients fitted for equilibrium conditions + ! SWSRF2 and SWSRF4 as wetness (not moisture) + ! MB: bug April 2018, AMIN1 function due to problems when spin up from + ! scratch (i.e. dry soil at time=0) + SWSRF2(N)=0.79437 - 0.99996*AMIN1(1.5,ZBAR) + 0.68801*(AMIN1(1.5,ZBAR))**2 + & + 0.04186*(AMIN1(1.5,ZBAR))**3 - 0.15042*(AMIN1(1.5,ZBAR))**4 + SWSRF4(N)=SWSRF2(N) + ENDIF ! srfmx is the maximum amount of water that can be added to the surface layer ! The choice of defining SWSRF4 like SWSRF2 needs to be better examined. @@ -1861,8 +2033,15 @@ subroutine gndtmp(dts,phi,zbar,thetaf,fh21,ht,xfice,tp, FICE) do l=lstart,N_GT xfice=xfice+fice(l) - enddo - xfice=xfice/((N_GT+1)-lstart) + enddo + + IF (phi < POROS_HighLat) THEN + xfice=xfice/((N_GT+1)-lstart) + ELSE + !PEAT + !MB: only first layer for total runoff reduction + xfice=AMIN1(1.0,fice(1)) + ENDIF Return From 79d315751ab0dd854be5255ea1241333dffb3dd9 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 14:29:23 -0500 Subject: [PATCH 04/66] add vars to srunoff --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index aa3b6b8d8..fae79bea9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -264,7 +264,8 @@ END SUBROUTINE INTERC SUBROUTINE SRUNOFF ( & NCH,DTSTEP,UFW4RO, FWETC, FWETL, AR1,ar2,ar4, THRUL,THRUC, & frice,tp1,srfmx, BUG, & - SRFEXC,RUNSRF, & + VGWMAX,RZEQ,POROS, & + SRFEXC,RUNSRF,RZEXC, & QINFIL & ) @@ -275,7 +276,7 @@ SUBROUTINE SRUNOFF ( & REAL, INTENT(IN) :: DTSTEP, FWETC, FWETL LOGICAL, INTENT (IN):: UFW4RO REAL, INTENT(IN), DIMENSION(NCH) :: AR1, ar2, ar4, frice, tp1, & - srfmx, THRUL, THRUC + srfmx, THRUL, THRUC, VGWMAX, RZEQ, POROS LOGICAL, INTENT(IN) :: BUG REAL, INTENT(INOUT), DIMENSION(NCH) :: SRFEXC ,RUNSRF From be25bcc7d9737bcb520fa4b57216479d53afdbea Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 14:58:59 -0500 Subject: [PATCH 05/66] define type --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index fae79bea9..52fc69e30 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -284,7 +284,8 @@ SUBROUTINE SRUNOFF ( & REAL, INTENT(OUT), DIMENSION(NCH) :: QINFIL INTEGER N - REAL deficit,srun0,frun,qin, qinfil_l, qinfil_c, qcapac, excess_infil, srunc, srunl, ptotal + REAL deficit,srun0,frun,qin, qinfil_l, qinfil_c, qcapac, excess_infil, & + srunc, srunl, ptotal, excess, totcapac, watadd !**** - - - - - - - - - - - - - - - - - - - - - - - - - From 1a82678569fea0ed408ec55a9d0ad98f45a5ce2f Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 15:58:23 -0500 Subject: [PATCH 06/66] adding rzexc type --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 52fc69e30..505c72b49 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -279,7 +279,7 @@ SUBROUTINE SRUNOFF ( & srfmx, THRUL, THRUC, VGWMAX, RZEQ, POROS LOGICAL, INTENT(IN) :: BUG - REAL, INTENT(INOUT), DIMENSION(NCH) :: SRFEXC ,RUNSRF + REAL, INTENT(INOUT), DIMENSION(NCH) :: SRFEXC ,RUNSRF, RZEXC REAL, INTENT(OUT), DIMENSION(NCH) :: QINFIL From 58170b0c7e0bc8aabaf758ff3717c33f12f9121f Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 17:46:13 -0500 Subject: [PATCH 07/66] define var types --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 505c72b49..f06caaefe 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -484,7 +484,7 @@ SUBROUTINE BASE ( & INTEGER, INTENT(IN) :: NCH REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: BF1, BF2, BF3, CDCR1, FRICE, COND, & - GNU + GNU, AR1, POROS, ars1, ars2, ars3 REAL, INTENT(INOUT), DIMENSION(NCH) :: CATDEF @@ -492,7 +492,7 @@ SUBROUTINE BASE ( & INTEGER N - REAL ZBAR, ashift + REAL ZBAR, ashift, CFRICE,Ksz_zero,m_Ivanov,v_slope,Ta,dztmp,SYSOIL,BFLOW_CATDEF,ICERAMP,AR1eq data ashift/0./ From 66b4e678f844cd2f4cc39ae33e36f49a22339f32 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 17:57:54 -0500 Subject: [PATCH 08/66] adding vars to sobroutine --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index f06caaefe..5f888d868 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -473,9 +473,9 @@ END SUBROUTINE SRUNOFF !**** ----------------------------------------------------------------- !**** SUBROUTINE BASE ( & - NCH,DTSTEP,BF1,BF2,BF3,CDCR1,FRICE,COND,GNU, & + NCH,DTSTEP,BF1,BF2,BF3,CDCR1,FRICE,COND,GNU,AR1,POROS, & CATDEF, & - BFLOW & + BFLOW,ars1,ars2,ars3 & ) IMPLICIT NONE From 907a493eb6e20f4b689b3e4565144b981bad055b Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 18:46:01 -0500 Subject: [PATCH 09/66] more vars need type --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 5f888d868..27d825d28 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -602,6 +602,7 @@ SUBROUTINE PARTITION ( & ARG1, EXPARG1, ARG2, EXPARG2, ARG3, EXPARG3 !, surflay LOGICAL :: LSTRESS + REAL :: ZBAR, ARREST DATA LSTRESS/.FALSE./ !,surflay/20./ From d3456890652c584fc229fafbd01a1f69daaeeb5c Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 18:52:40 -0500 Subject: [PATCH 10/66] edit --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 27d825d28..0bc1d652f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -584,7 +584,7 @@ SUBROUTINE PARTITION ( & REAL, INTENT(IN), DIMENSION(NCH) :: DZSF,RZEXC,RZEQ,VGWMAX,CDCR1,CDCR2, & PSIS,BEE,poros,WPWET, & ars1,ars2,ars3,ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4 + arw1,arw2,arw3,arw4,BF1,BF2 LOGICAL, INTENT(IN) :: BUG ! ------------------------------------------------------------------- From 51ca254c81e164f1d6f051c357daac34d9a99cff Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 19:10:24 -0500 Subject: [PATCH 11/66] minor edit --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 0bc1d652f..7da5573bb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -568,6 +568,7 @@ END SUBROUTINE BASE SUBROUTINE PARTITION ( & NCH,DTSTEP,DZSF,RZEXC,RZEQ,VGWMAX,CDCR1,CDCR2, & PSIS,BEE,poros,WPWET, & + BF1, BF2, & ars1,ars2,ars3,ara1,ara2,ara3,ara4, & arw1,arw2,arw3,arw4,BUG, & srfexc,catdef,runsrf, & From 4ca747981960fc6cdcc34870ecda1a1e05491d1a Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 19:27:25 -0500 Subject: [PATCH 12/66] enable NLv4p option in make_bcs --- .../GEOSsurface_GridComp/Utils/Raster/make_bcs | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs index d8b17283b..34c0502d4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs @@ -151,6 +151,7 @@ echo " files produced by current source codes may differ with echo " Nevertheless, the impact of those differences on science is insignificant and" echo " the parameter files produced by current source codes can be considered as " echo " scientifically equivalent to achieved BCs" +echo " ${C2}NL4p -- in development for peat testing" echo " " echo " (OR press ENTER If you want to use the develop version of land BCs.)" set dummy = `echo $<` From 57bcb3803aed8f512303fc2358c9b2c26cc6c8b0 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 19:41:51 -0500 Subject: [PATCH 13/66] order of arguments --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 7da5573bb..a8e205009 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -1531,12 +1531,12 @@ END SUBROUTINE SIBALB subroutine catch_calc_soil_moist( & NTILES,vegcls,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2, & - ara3,ara4,arw1,arw2,arw3,arw4, & + ara3,ara4,arw1,arw2,arw3,arw4,bf1, bf2, & srfexc,rzexc,catdef, & ar1, ar2, ar4, & sfmc, rzmc, prmc, & - werror, sfmcun, rzmcun, prmcun, & - swsrf1out, swsrf2out, swsrf4out ) + werror, sfmcun, rzmcun, prmcun ) + ! swsrf1out, swsrf2out, swsrf4out ) not needed with peat ! Calculate diagnostic soil moisture content from prognostic ! excess/deficit variables. @@ -1587,7 +1587,7 @@ subroutine catch_calc_soil_moist( & real, dimension(NTILES), intent(in) :: dzsf,vgwmax,cdcr1,cdcr2 real, dimension(NTILES), intent(in) :: wpwet,poros,psis - real, dimension(NTILES), intent(in) :: bee,ars1 + real, dimension(NTILES), intent(in) :: bee,ars1,bf1, bf2 real, dimension(NTILES), intent(in) :: ars2,ars3,ara1,ara2,ara3 real, dimension(NTILES), intent(in) :: ara4,arw1,arw2,arw3,arw4 @@ -1687,7 +1687,7 @@ subroutine catch_calc_soil_moist( & call partition( & NTILES,dtstep_dummy,dzsf,rzexc, & rzeq,vgwmax,cdcr1,cdcr2, & - psis,bee,poros,wpwet, & + psis,bee,poros,wpwet,bf1, bf2, & ars1,ars2,ars3, & ara1,ara2,ara3,ara4, & arw1,arw2,arw3,arw4,.false., & @@ -1696,9 +1696,6 @@ subroutine catch_calc_soil_moist( & swsrf1,swsrf2,swsrf4,rzi & ) - if(present(swsrf1out)) swsrf1out = swsrf1 - if(present(swsrf2out)) swsrf2out = swsrf2 - if(present(swsrf4out)) swsrf4out = swsrf4 ! compute surface, root zone, and profile soil moisture From 9bf1aa7e5e858d3fbb5e741d842cdf0fe9f20868 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 20:00:45 -0500 Subject: [PATCH 14/66] clean up --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index a8e205009..9b6b8eea0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -1536,7 +1536,6 @@ subroutine catch_calc_soil_moist( & ar1, ar2, ar4, & sfmc, rzmc, prmc, & werror, sfmcun, rzmcun, prmcun ) - ! swsrf1out, swsrf2out, swsrf4out ) not needed with peat ! Calculate diagnostic soil moisture content from prognostic ! excess/deficit variables. @@ -1602,7 +1601,6 @@ subroutine catch_calc_soil_moist( & real, dimension(NTILES), intent(out), optional :: sfmcun real, dimension(NTILES), intent(out), optional :: rzmcun real, dimension(NTILES), intent(out), optional :: prmcun - real, dimension(NTILES), intent(out), optional :: swsrf1out, swsrf2out, swsrf4out ! ---------------------------- ! From 43fcbe196c94599507f3dca19ab6ec807156a5c4 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Mon, 20 Dec 2021 20:47:41 -0500 Subject: [PATCH 15/66] bf1 and bf2 to call CATCH_CALC_SOIL_MOIST --- .../GEOS_CatchCNCLM40GridComp.F90 | 14 +++++++------- .../GEOS_CatchCNCLM45GridComp.F90 | 14 +++++++------- .../GEOScatchCN_GridComp/Shared/catchcn_iau.F90 | 2 +- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 8 ++++---- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 2 +- .../GEOScatch_GridComp/catch_incr.F90 | 2 +- .../GEOScatch_GridComp/catchment.F90 | 4 ++-- 7 files changed, 23 insertions(+), 23 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index f0c61251f..bda610e1a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -6436,8 +6436,8 @@ subroutine Driver ( RC ) ! gkw: obtain catchment area fractions and soil moisture ! ------------------------------------------------------ -call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, & +call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc ) ! obtain saturated canopy resistance following Farquhar, CLM4 implementation @@ -7312,9 +7312,9 @@ subroutine Driver ( RC ) IF ((RUN_IRRIG /= 0).AND.(ntiles >0)) THEN - CALL CATCH_CALC_SOIL_MOIST ( & - NTILES,VEG1,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4, & + CALL CATCH_CALC_SOIL_MOIST ( & + NTILES,VEG1,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, CAR1, CAR2, CAR4, sfmc, rzmc, prmc) call irrigation_rate (IRRIG_METHOD, & @@ -8515,11 +8515,11 @@ subroutine RUN0(gc, import, export, clock, rc) rzexccp = rzexc call catch_calc_soil_moist( & ! intent(in) - ntiles, nint(veg1), dzsf, vgwmax, cdcr1, cdcr2, & + ntiles, nint(veg1), dzsf, vgwmax, cdcr1, cdcr2, & psis, bee, poros, wpwet, & ars1, ars2, ars3, & ara1, ara2, ara3, ara4, & - arw1, arw2, arw3, arw4, & + arw1, arw2, arw3, arw4, bf1, bf2, & ! intent(inout) ! from process_cat srfexccp, rzexccp, catdefcp, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 133119f81..5c2b86c41 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -6495,9 +6495,9 @@ subroutine Driver ( RC ) ! gkw: obtain catchment area fractions and soil moisture ! ------------------------------------------------------ -call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, & - srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc, & +call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & + srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc, & SWSRF1OUT=SWSRF1, SWSRF2OUT=SWSRF2, SWSRF4OUT=SWSRF4 ) ! obtain saturated canopy resistance following Farquhar, CLM4 implementation @@ -7559,9 +7559,9 @@ subroutine Driver ( RC ) IF ((RUN_IRRIG /= 0).AND.(ntiles >0)) THEN - CALL CATCH_CALC_SOIL_MOIST ( & - NTILES,VEG1,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4, & + CALL CATCH_CALC_SOIL_MOIST ( & + NTILES,VEG1,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, CAR1, CAR2, CAR4, sfmc, rzmc, prmc) call irrigation_rate (IRRIG_METHOD, & @@ -8814,7 +8814,7 @@ subroutine RUN0(gc, import, export, clock, rc) psis, bee, poros, wpwet, & ars1, ars2, ars3, & ara1, ara2, ara3, ara4, & - arw1, arw2, arw3, arw4, & + arw1, arw2, arw3, arw4, bf1, bf2, & ! intent(inout) ! from process_cat srfexccp, rzexccp, catdefcp, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 index 89481e2bd..9923b4516 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 @@ -221,7 +221,7 @@ subroutine check_catchcn_progn( NTILES, & call catch_calc_soil_moist( & NTILES,veg,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2, & - ara3,ara4,arw1,arw2,arw3,arw4, & + ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, & ar1, ar2, ar4 ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 80c784876..a94db45b3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -1191,7 +1191,7 @@ SUBROUTINE CATCHCN ( & CALL CATCH_CALC_SOIL_MOIST ( & nch,ityp1,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4, & + ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, & AR1, AR2, AR4, & sfmc, rzmc, prmc, & @@ -2744,9 +2744,9 @@ subroutine catchcn_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & rzexc_tmp = rzexc ! rzexc is "inout" in catch_calc_soil_moist() catdef_tmp = catdef ! catdef is "inout" in catch_calc_soil_moist() - call catch_calc_soil_moist( & - NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, & + call catch_calc_soil_moist( & + NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4,bf1, bf2,& srfexc_tmp, rzexc_tmp, catdef_tmp, ar1, ar2, ar4 ) ! compute snow-free tsurf diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 1de117075..7ea3bd724 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -6046,7 +6046,7 @@ subroutine RUN0(gc, import, export, clock, rc) psis, bee, poros, wpwet, & ars1, ars2, ars3, & ara1, ara2, ara3, ara4, & - arw1, arw2, arw3, arw4, & + arw1, arw2, arw3, arw4,bf1, bf2, & ! intent(inout) ! from process_cat srfexccp, rzexccp, catdefcp, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 index 3649b719a..43b774fc7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 @@ -212,7 +212,7 @@ subroutine check_catch_progn( NTILES, & call catch_calc_soil_moist( & NTILES,veg,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2, & - ara3,ara4,arw1,arw2,arw3,arw4, & + ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, & ar1, ar2, ar4 ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index c39434cc1..b0df70873 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -1204,7 +1204,7 @@ SUBROUTINE CATCHMENT ( & CALL CATCH_CALC_SOIL_MOIST ( & nch,ityp,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4, & + ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, & AR1, AR2, AR4, & sfmc, rzmc, prmc, & @@ -3258,7 +3258,7 @@ subroutine catch_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & call catch_calc_soil_moist( & NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & srfexc_tmp, rzexc_tmp, catdef_tmp, ar1, ar2, ar4 ) ! compute snow-free tsurf From d1608935cef79a37e412da23857061b5886675c7 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 10:22:46 -0500 Subject: [PATCH 16/66] more cleanup --- .../GEOScatchCN_GridComp/Shared/catchcn_iau.F90 | 5 +++++ .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 8 +++++++- .../GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 | 9 +++++++-- 3 files changed, 19 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 index 9923b4516..06e05db1a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 @@ -25,6 +25,7 @@ module catchcn_iau subroutine apply_catchcn_iau( NTILES, & VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & + bf1, bf2, & TG1_INC, TG2_INC, TG4_INC, & TC1_INC, TC2_INC, TC4_INC, QC1_INC, QC2_INC, QC4_INC, & CAPAC_INC, CATDEF_INC, RZEXC_INC, SRFEXC_INC, & @@ -45,6 +46,7 @@ subroutine apply_catchcn_iau( NTILES, & real, dimension( NTILES), intent(in) :: ARS1, ARS2, ARS3 real, dimension( NTILES), intent(in) :: ARA1, ARA2, ARA3, ARA4 real, dimension( NTILES), intent(in) :: ARW1, ARW2, ARW3, ARW4 + real, dimension( NTILES), intent(in) :: bf1, bf2 ! CATCHMENT-CN MODEL PROGNOSTIC INCREMENTS @@ -97,6 +99,7 @@ subroutine apply_catchcn_iau( NTILES, & call check_catchcn_progn( NTILES, & VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & + bf1, bf2, & TG1, TG2, TG4, TC1, TC2, TC4, QC1, QC2, QC4, & CAPAC, CATDEF, RZEXC, SRFEXC, & GHTCNT, WESNN, HTSNNN, SNDZN ) @@ -108,6 +111,7 @@ end subroutine apply_catchcn_iau subroutine check_catchcn_progn( NTILES, & VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & + bf1, bf2, & TG1, TG2, TG4, TC1, TC2, TC4, QC1, QC2, QC4, & CAPAC, CATDEF, RZEXC, SRFEXC, & GHTCNT, WESNN, HTSNNN, SNDZN ) @@ -138,6 +142,7 @@ subroutine check_catchcn_progn( NTILES, & real, dimension( NTILES), intent(in) :: ARS1, ARS2, ARS3 real, dimension( NTILES), intent(in) :: ARA1, ARA2, ARA3, ARA4 real, dimension( NTILES), intent(in) :: ARW1, ARW2, ARW3, ARW4 + real, dimension( NTILES), intent(in) :: bf1, bf2 ! CATCHMENT-CN MODEL PROGNOSTICS diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 7ea3bd724..d9a044151 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -5373,7 +5373,7 @@ subroutine Driver ( RC ) call apply_catch_incr(NTILES, & VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & - ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & + ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, bf1, bf2, & TCFSAT_INCR, TCFTRN_INCR, TCFWLT_INCR, QCFSAT_INCR, QCFTRN_INCR, QCFWLT_INCR, & CAPAC_INCR, CATDEF_INCR, RZEXC_INCR, SRFEXC_INCR, & GHTCNT_INCR, WESNN_INCR, HTSNNN_INCR, SNDZN_INCR, & @@ -5896,6 +5896,8 @@ subroutine RUN0(gc, import, export, clock, rc) real, pointer :: arw2(:)=>null() real, pointer :: arw3(:)=>null() real, pointer :: arw4(:)=>null() + real, pointer :: bf1(:)=>null() + real, pointer :: bf2(:)=>null() !! Miscellaneous integer :: ntiles @@ -5989,6 +5991,10 @@ subroutine RUN0(gc, import, export, clock, rc) VERIFY_(status) call MAPL_GetPointer(INTERNAL, arw4, 'ARW4', rc=status) VERIFY_(status) + call MAPL_GetPointer(INTERNAL, bf1, 'BF1', rc=status) + VERIFY_(status) + call MAPL_GetPointer(INTERNAL, bf2, 'BF2', rc=status) + VERIFY_(status) call MAPL_GetPointer(INTERNAL, srfexc, 'SRFEXC', rc=status) VERIFY_(status) call MAPL_GetPointer(INTERNAL, rzexc, 'RZEXC', rc=status) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 index 43b774fc7..4c613a76e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 @@ -21,9 +21,10 @@ module catch_incr ! *********************************************************************** - subroutine apply_catch_incr( NTILES, & + subroutine apply_catch_incr( NTILES, & VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & + bf1, bf2, & TC1_INC, TC2_INC, TC4_INC, QC1_INC, QC2_INC, QC4_INC, & CAPAC_INC, CATDEF_INC, RZEXC_INC, SRFEXC_INC, & GHTCNT_INC, WESNN_INC, HTSNNN_INC, SNDZN_INC, & @@ -43,6 +44,7 @@ subroutine apply_catch_incr( NTILES, & real, dimension( NTILES), intent(in) :: ARS1, ARS2, ARS3 real, dimension( NTILES), intent(in) :: ARA1, ARA2, ARA3, ARA4 real, dimension( NTILES), intent(in) :: ARW1, ARW2, ARW3, ARW4 + real, dimension( NTILES), intent(in) :: bf1, bf2 ! CATCHMENT MODEL PROGNOSTIC INCREMENTS @@ -88,7 +90,8 @@ subroutine apply_catch_incr( NTILES, & call check_catch_progn( NTILES, & VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & - ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & + ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & + bf1,bf2, & TC1, TC2, TC4, QC1, QC2, QC4, & CAPAC, CATDEF, RZEXC, SRFEXC, & GHTCNT, WESNN, HTSNNN, SNDZN ) @@ -100,6 +103,7 @@ end subroutine apply_catch_incr subroutine check_catch_progn( NTILES, & VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & + bf1,bf2, & TC1, TC2, TC4, QC1, QC2, QC4, & CAPAC, CATDEF, RZEXC, SRFEXC, & GHTCNT, WESNN, HTSNNN, SNDZN ) @@ -130,6 +134,7 @@ subroutine check_catch_progn( NTILES, & real, dimension( NTILES), intent(in) :: ARS1, ARS2, ARS3 real, dimension( NTILES), intent(in) :: ARA1, ARA2, ARA3, ARA4 real, dimension( NTILES), intent(in) :: ARW1, ARW2, ARW3, ARW4 + real, dimension( NTILES), intent(in) :: bf1,bf2 ! CATCHMENT MODEL PROGNOSTICS From 096bd9660d921cb82593034b557282eaee7c9e2b Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 10:58:45 -0500 Subject: [PATCH 17/66] bf1 and bf2 were missing here --- .../GEOScatch_GridComp/catchment.F90 | 35 ++++++++++--------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index b0df70873..5d08b0245 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -630,6 +630,7 @@ SUBROUTINE CATCHMENT ( & CALL PARTITION ( & NCH,DTSTEP,DZSF,RZEXC, RZEQOL,VGWMAX,CDCR1,CDCR2, & PSIS,BEE,poros,WPWET, & + bf1, bf2, & ars1,ars2,ars3,ara1,ara2,ara3,ara4, & arw1,arw2,arw3,arw4,BUG, & SRFEXC,CATDEF,RUNSRF, & @@ -1106,11 +1107,11 @@ SUBROUTINE CATCHMENT ( & CALL WUPDAT ( & - NCH, DTSTEP, EVAPFR, SATCAP, TC1, RA1, RC, & + NCH, DTSTEP,BF1, BF2, EVAPFR, SATCAP, TC1, RA1, RC, & RX11,RX21,RX12,RX22,RX14,RX24, & - AR1,AR2,AR4,CDCR1,EIRFRC,RZEQOL,srfmn,WPWET,VGWMAX, & + AR1,AR2,AR4,CDCR1,EIRFRC,RZEQOL,srfmn,WPWET,VGWMAX,POROS, & CAPAC, RZEXC, CATDEF, SRFEXC, & - EINT, ESOI, EVEG & + EINT, ESOI, EVEG, ARS1,ARS2,ARS3 & ) ! --------------------------------------------------------------------- @@ -1122,9 +1123,9 @@ SUBROUTINE CATCHMENT ( & !**** REDISTRIBUTE MOISTURE BETWEEN RESERVOIRS: CALL RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET, & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET,BF1, BF2, & tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & - CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF & + CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ars1,ars2,ars3 & ) ! --------------------------------------------------------------------- @@ -1136,9 +1137,9 @@ SUBROUTINE CATCHMENT ( & !**** COMPUTE BASEFLOW FROM TOPMODEL EQUATIONS CALL BASE ( & - NCH, DTSTEP,BF1, BF2, BF3, CDCR1, FRICE, COND, GNU, & + NCH, DTSTEP,BF1, BF2, BF3, CDCR1, FRICE, COND, GNU,AR1, POROS,& CATDEF, & - BFLOW & + BFLOW, ars1,ars2,ars3 & ) ! --------------------------------------------------------------------- @@ -1665,9 +1666,9 @@ END SUBROUTINE CATCHMENT !**** =================================================== SUBROUTINE RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQ,AR1,WPWET, & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQ,AR1,WPWET,BF1, BF2, & tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & - CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF & + CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ars1,ars2,ars3 & ) !----------------------------------------------------------------- @@ -1682,7 +1683,7 @@ SUBROUTINE RZDRAIN ( & INTEGER, INTENT(IN) :: NCH REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: VGWMAX, SATCAP, RZEQ, AR1, wpwet, & - tsa1, tsa2, tsb1, tsb2, atau, btau, CDCR2, poros + tsa1, tsa2, tsb1, tsb2, atau, btau, CDCR2, poros, BF1, BF2, ars1, ars2, ars3 LOGICAL, INTENT(IN) :: BUG REAL, INTENT(INOUT), DIMENSION(NCH) :: RZEXC, SRFEXC, CATDEF, CAPAC, & @@ -2804,11 +2805,11 @@ END SUBROUTINE TMPFAC !**** [ BEGIN WUPDAT ] !**** SUBROUTINE WUPDAT ( & - NCH, DTSTEP, EVAP, SATCAP, TC, RA, RC, & + NCH, DTSTEP, BF1, BF2, EVAP, SATCAP, TC, RA, RC, & RX11,RX21,RX12,RX22,RX14,RX24, AR1,AR2,AR4,CDCR1, & - EIRFRC,RZEQ,srfmn,WPWET,VGWMAX, & + EIRFRC,RZEQ,srfmn,WPWET,VGWMAX, POROS, & CAPAC, RZEXC, CATDEF, SRFEXC, & - EINT, ESOI, EVEG & + EINT, ESOI, EVEG,ars1,ars2,ars3 & ) !**** !**** THIS SUBROUTINE ALLOWS EVAPOTRANSPIRATION TO ADJUST THE WATER @@ -2821,7 +2822,7 @@ SUBROUTINE WUPDAT ( & REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: EVAP, SATCAP, TC, RA, RC, RX11, & RX21, RX12, RX22, RX14, RX24, AR1, AR2, AR4, CDCR1, EIRFRC, & - RZEQ, srfmn, WPWET, VGWMAX + RZEQ, srfmn, WPWET, VGWMAX, POROS, BF1, BF2, ars1,ars2,ars3 REAL, INTENT(INOUT), DIMENSION(NCH) :: CAPAC, CATDEF, RZEXC, SRFEXC @@ -2830,10 +2831,12 @@ SUBROUTINE WUPDAT ( & INTEGER CHNO REAL EGRO, CNDSAT, CNDUNS, ESATFR, cndv, cnds, WILT, egromx,rzemax + REAL :: ZBAR1,SYSOIL,ET_CATDEF,AR1eq !**** !**** ----------------------------------------------------------------- DO 100 CHNO = 1, NCH + ZBAR1=SQRT(1.e-20+CATDEF(CHNO)/BF1(CHNO))-BF2(CHNO) !**** COMPUTE EFFECTIVE SURFACE CONDUCTANCES IN SATURATED AND UNSATURATED !**** AREAS: @@ -3205,7 +3208,7 @@ end subroutine catch_calc_tsurf_excl_snow ! ******************************************************************* subroutine catch_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & - psis, bee, poros, wpwet, & + psis, bee, poros, wpwet, bf1, bf2, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, & srfexc, rzexc, catdef, tc1, tc2, tc4, wesnn, htsnn, ghtcnt, & etotl ) @@ -3224,7 +3227,7 @@ subroutine catch_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & integer, dimension( NTILES), intent(in) :: vegcls real, dimension( NTILES), intent(in) :: dzsf real, dimension( NTILES), intent(in) :: vgwmax - real, dimension( NTILES), intent(in) :: cdcr1, cdcr2 + real, dimension( NTILES), intent(in) :: cdcr1, cdcr2, bf1, bf2 real, dimension( NTILES), intent(in) :: psis, bee, poros, wpwet real, dimension( NTILES), intent(in) :: ars1, ars2, ars3 real, dimension( NTILES), intent(in) :: ara1, ara2, ara3, ara4 From e9fb2b9b33c96d4d1379077e09a130b441951689 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 11:12:50 -0500 Subject: [PATCH 18/66] edits --- .../Shared/catchmentCN.F90 | 34 +++++++++++-------- .../GEOScatch_GridComp/catchment.F90 | 4 ++- 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index a94db45b3..bd8209040 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -634,6 +634,7 @@ SUBROUTINE CATCHCN ( & CALL PARTITION ( & NCH,DTSTEP,DZSF,RZEXC, RZEQOL,VGWMAX,CDCR1,CDCR2, & PSIS,BEE,poros,WPWET, & + bf1, bf2, & ars1,ars2,ars3,ara1,ara2,ara3,ara4, & arw1,arw2,arw3,arw4,BUG, & SRFEXC,CATDEF,RUNSRF, & @@ -1081,13 +1082,13 @@ SUBROUTINE CATCHCN ( & !**** REMOVE EVAPORATED WATER FROM SURFACE RESERVOIRS: CALL WUPDAT ( & - NCH, DTSTEP, & + NCH, DTSTEP, BF1, BF2, & EVAPFR, SATCAP, TG1, RA1, RC, & AR1,AR2,AR4,CDCR1, ESATFR, & - RZEQOL,SRFMN,WPWET,VGWMAX, & + RZEQOL,SRFMN,WPWET,VGWMAX, POROS, & CAPAC, RZEXC, CATDEF, SRFEXC, & ESOI, EVEG, EINT, & - ECORR & + ECORR, ARS1,ARS2,ARS3 & ) !**** UPDATE SENSIBLE HEAT IF WATER LIMITATIONS WERE IMPOSED: @@ -1109,9 +1110,9 @@ SUBROUTINE CATCHCN ( & !**** REDISTRIBUTE MOISTURE BETWEEN RESERVOIRS: CALL RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET, & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET,BF1, BF2 & tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & - CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF & + CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ARS1,ARS2,ARS3 & ) ! --------------------------------------------------------------------- @@ -1123,9 +1124,9 @@ SUBROUTINE CATCHCN ( & !**** COMPUTE BASEFLOW FROM TOPMODEL EQUATIONS CALL BASE ( & - NCH, DTSTEP,BF1, BF2, BF3, CDCR1, FRICE, COND, GNU, & + NCH, DTSTEP,BF1, BF2, BF3, CDCR1, FRICE, COND, GNU,AR1, POROS,& CATDEF, & - BFLOW & + BFLOW,ars1,ars2,ars3 & ) ! --------------------------------------------------------------------- @@ -1642,9 +1643,9 @@ END SUBROUTINE CATCHCN !**** =================================================== SUBROUTINE RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQ,AR1,WPWET, & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQ,AR1,WPWET,BF1, BF2, & tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & - CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF & + CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ars1,ars2,ars3 & ) !----------------------------------------------------------------- @@ -1659,7 +1660,7 @@ SUBROUTINE RZDRAIN ( & INTEGER, INTENT(IN) :: NCH REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: VGWMAX, SATCAP, RZEQ, AR1, wpwet, & - tsa1, tsa2, tsb1, tsb2, atau, btau, CDCR2, poros + tsa1, tsa2, tsb1, tsb2, atau, btau, CDCR2, poros, BF1, BF2, ars1, ars2, ars3 LOGICAL, INTENT(IN) :: BUG REAL, INTENT(INOUT), DIMENSION(NCH) :: RZEXC, SRFEXC, CATDEF, CAPAC, & @@ -1667,8 +1668,10 @@ SUBROUTINE RZDRAIN ( & INTEGER N + REAL srflw,rzflw,FLOW,EXCESS,TSC0,tsc2,rzave,rz0,wanom,rztot, & - rzx,btaux,ax,bx,rzdif + rzx,btaux,ax,bx,rzdif,ZBAR1, SYSOIL,RZFLW_CATDEF,EXCESS_CATDEF, & + CATDEF_PEAT_THRESHOLD,RZFLW_AR1, AR1eq !**** - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2329,13 +2332,13 @@ END SUBROUTINE MATRIX_CALC !**** [ BEGIN WUPDAT ] !**** SUBROUTINE WUPDAT ( & - NCH, DTSTEP, & + NCH, DTSTEP, BF1, BF2, & EVAP, SATCAP, TC, RA, RC, & AR1,AR2,AR4,CDCR1, ESATFR, & - RZEQ,SRFMN,WPWET,VGWMAX, & + RZEQ,SRFMN,WPWET,VGWMAX, POROS, & CAPAC, RZEXC, CATDEF, SRFEXC, & EVROOT, EVSURF, EVINT, & - ECORR & + ECORR, ars1,ars2,ars3 & ) !**** !**** THIS SUBROUTINE ALLOWS EVAPOTRANSPIRATION TO ADJUST THE WATER @@ -2355,11 +2358,12 @@ SUBROUTINE WUPDAT ( & INTEGER N REAL EGRO,CNDSAT,CNDUNS,CNDV,CNDS,WILT,EGROMX,RZEMAX + REAL :: ZBAR1,SYSOIL,ET_CATDEF,AR1eq !**** !**** ----------------------------------------------------------------- DO 100 N = 1, NCH - + ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) !**** !**** PARTITION EVAP BETWEEN INTERCEPTION AND GROUND RESERVOIRS. !**** diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 5d08b0245..5fd0b6616 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -1692,7 +1692,9 @@ SUBROUTINE RZDRAIN ( & INTEGER N REAL srflw,rzflw,FLOW,EXCESS,TSC0,tsc2,rzave,rz0,wanom,rztot, & - rzx,btaux,ax,bx,rzdif, rzavemin + rzx,btaux,ax,bx,rzdif, rzavemin,ZBAR1,SYSOIL,RZFLW_CATDEF, & + EXCESS_CATDEF, CATDEF_PEAT_THRESHOLD, RZFLW_AR1, AR1eq + !**** - - - - - - - - - - - - - - - - - - - - - - - - - From d85f25eb9308a735bb9e657644824936202803fe Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 11:32:53 -0500 Subject: [PATCH 19/66] typo --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index bd8209040..107a4f38d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -1110,7 +1110,7 @@ SUBROUTINE CATCHCN ( & !**** REDISTRIBUTE MOISTURE BETWEEN RESERVOIRS: CALL RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET,BF1, BF2 & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET,BF1,BF2, & tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ARS1,ARS2,ARS3 & ) @@ -2349,7 +2349,8 @@ SUBROUTINE WUPDAT ( & INTEGER, INTENT(IN) :: NCH REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: EVAP, SATCAP, TC, RA, RC, AR1, & - AR2, AR4, CDCR1, ESATFR, RZEQ, SRFMN, WPWET, VGWMAX + AR2, AR4, CDCR1, ESATFR, RZEQ, SRFMN, WPWET, VGWMAX, & + POROS, BF1, BF2, ars1, ars2, ars3 REAL, INTENT(INOUT), DIMENSION(NCH) :: CAPAC, RZEXC, CATDEF, & SRFEXC, EVROOT, EVSURF, EVINT From 8560022db6e548758fea5d026ce7b899360b4aaa Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 12:13:27 -0500 Subject: [PATCH 20/66] missing porosity at some calls --- .../Shared/catchmentCN.F90 | 6 ++--- .../GEOScatch_GridComp/catchment.F90 | 22 ++++++++++++++----- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 107a4f38d..af235f307 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -618,7 +618,7 @@ SUBROUTINE CATCHCN ( & !**** DETERMINE INITIAL VALUE OF RZEQ: CALL RZEQUIL ( & - NCH, CATDEF, VGWMAX,CDCR1,CDCR2,WPWET, & + NCH, CATDEF, VGWMAX,CDCR1,CDCR2,WPWET,POROS, & ars1,ars2,ars3,ara1,ara2,ara3,ara4, & arw1,arw2,arw3,arw4, & RZEQOL & @@ -1152,7 +1152,7 @@ SUBROUTINE CATCHCN ( & CALL SRUNOFF ( NCH,DTSTEP,UFW4RO, FWETC, FWETL, & AR1,ar2,ar4,THRUL, THRUC,frice,tp1,srfmx,BUG, & - SRFEXC,RUNSRF, & + SRFEXC,RUNSRF,POROS, & QINFIL & ) @@ -1165,7 +1165,7 @@ SUBROUTINE CATCHCN ( & !**** RECOMPUTE RZEXC: CALL RZEQUIL ( & - NCH, CATDEF, VGWMAX,CDCR1,CDCR2,WPWET, & + NCH, CATDEF, VGWMAX,CDCR1,CDCR2,WPWET,POROS, & ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4, & RZEQ & ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 5fd0b6616..1d5b67e14 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -610,7 +610,7 @@ SUBROUTINE CATCHMENT ( & !**** DETERMINE INITIAL VALUE OF RZEQ: CALL RZEQUIL ( & - NCH, CATDEF, VGWMAX,CDCR1,CDCR2,WPWET, & + NCH, CATDEF, VGWMAX,CDCR1,CDCR2,WPWET,POROS, & ars1,ars2,ars3,ara1,ara2,ara3,ara4, & arw1,arw2,arw3,arw4, & RZEQOL & @@ -772,7 +772,7 @@ SUBROUTINE CATCHMENT ( & !**** 3. WILTING FRACTION !CC print*,'energy4' CALL ENERGY4 ( & - NCH, DTSTEP, ITYP, UM, RCST, & + NCH, DTSTEP, ITYP,POROS, UM, RCST, & ETURB4, DEDQA4X, DEDTC4X, HSTURB4, DHSDQA4X, DHSDTC4X, & QM, RA4, SWNETF, HLWDWN, PSUR, & RDCX, HFTDS4, DHFT4, QSAT4, DQS4, ALW4, BLW4, & @@ -1165,7 +1165,8 @@ SUBROUTINE CATCHMENT ( & CALL SRUNOFF ( NCH,DTSTEP,UFW4RO, FWETC, FWETL, & AR1,ar2,ar4,THRUL, THRUC,frice,tp1,srfmx,BUG, & - SRFEXC,RUNSRF, & + VGWMAX,RZEQOL,POROS, & + SRFEXC,RUNSRF,RZEXC, & QINFIL & ) @@ -1178,7 +1179,7 @@ SUBROUTINE CATCHMENT ( & !**** RECOMPUTE RZEXC: CALL RZEQUIL ( & - NCH, CATDEF, VGWMAX,CDCR1,CDCR2,WPWET, & + NCH, CATDEF, VGWMAX,CDCR1,CDCR2,WPWET,POROS, & ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4, & RZEQ & ) @@ -2383,7 +2384,7 @@ END SUBROUTINE energy2 !**** ----------------------------------------------------------------- !**** SUBROUTINE energy4 ( & - NCH, DTSTEP, ITYP, UM, RCIN, & + NCH, DTSTEP, ITYP, POROS,UM, RCIN, & ETURB, DEDQA, DEDTC, HSTURB, DHSDQA, DHSDTC, & QM, RA, SWNET, HLWDWN, PSUR, & RDC, HFTDS, DHFTDS, & @@ -2402,7 +2403,7 @@ SUBROUTINE energy4 ( & REAL, INTENT(IN), DIMENSION(NCH) :: UM, RCIN, ETURB, HSTURB, QM, RA, & SWNET, HLWDWN, PSUR, RDC, HFTDS, DHFTDS, QSATTC, DQSDTC, & ALWRAD, BLWRAD, EMAXRT, CSOIL, SWSRF, POTFRC, WPWET, DEDQA, & - DEDTC, DHSDQA, DHSDTC + DEDTC, DHSDQA, DHSDTC, POROS LOGICAL, INTENT(IN) :: BUG REAL, INTENT(INOUT), DIMENSION(NCH) :: TC, QA @@ -2441,6 +2442,15 @@ SUBROUTINE energy4 ( & DEDEA(CHNO) = DEDQA(CHNO) * EPSILON / PSUR(CHNO) DHSDEA(CHNO) = DHSDQA(CHNO) * EPSILON / PSUR(CHNO) + IF (POROS(CHNO) < POROS_HighLat) THEN + ! mineral soil + SWSRF4(CHNO) = SWSRF(CHNO) + ELSE + ! PEAT + ! MB: For ET calculation, AR4 surface wetness is set to WPWET + SWSRF4(CHNO) = WPWET(CHNO) + ENDIF + 100 CONTINUE !**** From 2bc3180ab50334b7acf2d21db91eaaa458c2e790 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 12:36:31 -0500 Subject: [PATCH 21/66] poros in subtoutine calls --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 9b6b8eea0..ed779be76 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -842,7 +842,7 @@ END SUBROUTINE PARTITION !**** ----------------------------------------------------------------- SUBROUTINE RZEQUIL ( & - NCH,CATDEF,VGWMAX,CDCR1,CDCR2,WPWET, & + NCH,CATDEF,VGWMAX,CDCR1,CDCR2,WPWET,POROS, & ars1,ars2,ars3,ara1,ara2,ara3,ara4, & arw1,arw2,arw3,arw4, & RZEQ & @@ -853,7 +853,7 @@ SUBROUTINE RZEQUIL ( & INTEGER, INTENT(IN) :: NCH REAL, INTENT(IN), DIMENSION(NCH) :: CATDEF, VGWMAX, CDCR1, CDCR2, & WPWET, ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, & - arw2, arw3, arw4 + arw2, arw3, arw4, POROS REAL, INTENT(OUT), DIMENSION(NCH) :: RZEQ @@ -1647,7 +1647,7 @@ subroutine catch_calc_soil_moist( & call rzequil( & NTILES, catdef, vgwmax, & - cdcr1, cdcr2, wpwet, & + cdcr1, cdcr2, wpwet, poros, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, & arw1, arw2, arw3, arw4, & rzeq) From 14f253ec341261f0924240e84d83d04c4d6aaccf Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 12:51:00 -0500 Subject: [PATCH 22/66] wrong code placement --- .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 1d5b67e14..13d7de1b0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -2035,14 +2035,6 @@ SUBROUTINE energy1 ( & DEDEA(CHNO) = DEDQA(CHNO) * EPSILON / PSUR(CHNO) DHSDEA(CHNO) = DHSDQA(CHNO) * EPSILON / PSUR(CHNO) - IF (POROS(CHNO) < POROS_HighLat) THEN - ! mineral soil - SWSRF4(CHNO) = SWSRF(CHNO) - ELSE - ! PEAT - ! MB: For ET calculation, AR4 surface wetness is set to WPWET - SWSRF4(CHNO) = WPWET(CHNO) - ENDIF 100 CONTINUE From 3cf5a62f3f1e402e0c936c53accee7a588f2cc23 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 13:20:32 -0500 Subject: [PATCH 23/66] missing decelaratio --- .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 13d7de1b0..a85c15d1e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -2406,7 +2406,7 @@ SUBROUTINE energy4 ( & INTEGER ChNo, N REAL, DIMENSION(NCH) :: DEDEA, DHSDEA, EM, ESATTC, DESDTC, EA, RC, & - DRCDTC, DRCDEA + DRCDTC, DRCDEA, SWSRF4 REAL DELTC, DELEA !**** From c78bb0c4ff73cd701ec46eb534369c12b710ec85 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 13:38:44 -0500 Subject: [PATCH 24/66] more edits --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index af235f307..2c1dbd291 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -1152,7 +1152,8 @@ SUBROUTINE CATCHCN ( & CALL SRUNOFF ( NCH,DTSTEP,UFW4RO, FWETC, FWETL, & AR1,ar2,ar4,THRUL, THRUC,frice,tp1,srfmx,BUG, & - SRFEXC,RUNSRF,POROS, & + VGWMAX,RZEQOL,POROS, & + SRFEXC,RUNSRF,RZEXC, & QINFIL & ) From f8651e1db513f711bd58983fb6f2b1182d176348 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 14:26:17 -0500 Subject: [PATCH 25/66] fix type --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 2c1dbd291..236b34915 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -2717,7 +2717,7 @@ subroutine catchcn_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & integer, dimension( NTILES), intent(in) :: vegcls real, dimension( NTILES), intent(in) :: dzsf real, dimension( NTILES), intent(in) :: vgwmax - real, dimension( NTILES), intent(in) :: cdcr1, cdcr2 + real, dimension( NTILES), intent(in) :: cdcr1, cdcr2, bf1, bf2 real, dimension( NTILES), intent(in) :: psis, bee, poros, wpwet real, dimension( NTILES), intent(in) :: ars1, ars2, ars3 real, dimension( NTILES), intent(in) :: ara1, ara2, ara3, ara4 From 614c6bbcbaa592565d00e6c84778d76982e9ebcb Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 15:13:09 -0500 Subject: [PATCH 26/66] forgot to save change --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 236b34915..ba5652f3d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -2697,10 +2697,10 @@ end subroutine catchcn_calc_tsurf_excl_snow ! ******************************************************************* subroutine catchcn_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & - psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, & - srfexc, rzexc, catdef, tc1, tc2, tc4, tg1, tg2, tg4, & - wesnn, htsnn, ghtcnt, & + psis, bee, poros, wpwet,bf1, bf2, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, & + srfexc, rzexc, catdef, tc1, tc2, tc4, tg1, tg2, tg4, & + wesnn, htsnn, ghtcnt, & etotl ) ! compute total energy stored in land tiles From e32e95f7d08b54fcaa91fdd888f9db7eeed301fe Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 16:29:56 -0500 Subject: [PATCH 27/66] fixing alignment --- .../GEOS_CatchCNCLM40GridComp.F90 | 22 +- .../GEOS_CatchCNCLM45GridComp.F90 | 248 +++++++++--------- 2 files changed, 135 insertions(+), 135 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index bda610e1a..1c3b11975 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -5547,17 +5547,17 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,CNLAI41, 'CNLAI41' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNLAI42, 'CNLAI42' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNLAI43, 'CNLAI43' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU001,'RMELTDU001', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU002,'RMELTDU002', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU003,'RMELTDU003', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU004,'RMELTDU004', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU005,'RMELTDU005', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTBC001,'RMELTBC001', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTBC002,'RMELTBC002', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTOC001,'RMELTOC001', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTOC002,'RMELTOC002', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WATERTABLED,'WATERTABLED',RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSWCHANGE, 'FSWCHANGE', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU001,'RMELTDU001', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU002,'RMELTDU002', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU003,'RMELTDU003', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU004,'RMELTDU004', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU005,'RMELTDU005', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTBC001,'RMELTBC001', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTBC002,'RMELTBC002', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTOC001,'RMELTOC001', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTOC002,'RMELTOC002', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WATERTABLED ,'WATERTABLED', RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWCHANGE , 'FSWCHANGE', RC=STATUS); VERIFY_(STATUS) IF (RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) NTILES = size(PS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 5c2b86c41..231244529 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -5410,116 +5410,116 @@ subroutine Driver ( RC ) ! EXPORT POINTERS ! ----------------------------------------------------- - call MAPL_GetPointer(EXPORT,EVAPOUT,'EVAPOUT',ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SUBLIM,'SUBLIM',ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SHOUT, 'SHOUT' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RUNOFF, 'RUNOFF' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,EVPINT, 'EVPINT' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,EVPSOI, 'EVPSOI' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,EVPVEG, 'EVPVEG' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,EVPICE, 'EVPICE' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WAT10CM,'WAT10CM',ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WATSOI, 'WATSOI' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ICESOI, 'ICESOI' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,EVPSNO, 'EVPSNO' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,BFLOW, 'BASEFLOW',ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RUNSURF,'RUNSURF',ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SMELT, 'SMELT' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HLWUP, 'HLWUP' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SWNDSRF,'SWNDSRF',ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LWNDSRF,'LWNDSRF',ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,HLATN, 'HLATN' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,QINFIL, 'QINFIL' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,AR1, 'AR1' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,AR2, 'AR2' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RZEQ, 'RZEQ' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,GHFLX, 'GHFLX' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TPSURF, 'TPSURF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TPSN1, 'TPSNOW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TPUST, 'TPUNST' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TPSAT, 'TPSAT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TPWLT, 'TPWLT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ASNOW, 'ASNOW' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SHSNOW, 'SHSNOW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,AVETSNOW,'AVETSNOW', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FRSAT, 'FRSAT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FRUST, 'FRUST' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FRWLT, 'FRWLT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TP1, 'TP1' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TP2, 'TP2' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TP3, 'TP3' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TP4, 'TP4' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TP5, 'TP5' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TP6, 'TP6' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,EMIS, 'EMIS' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBVR, 'ALBVR' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBVF, 'ALBVF' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBNR, 'ALBNR' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ALBNF, 'ALBNF' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DELTS, 'DELTS' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DELQS, 'DELQS' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TST , 'TST' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,QST , 'QST' ,ALLOC=.true.,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LST , 'LST' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WET1 , 'WET1' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WET2 , 'WET2' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WET3 , 'WET3' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WCSF , 'WCSF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WCRZ , 'WCRZ' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WCPR , 'WCPR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,ACCUM, 'ACCUM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SNOMAS,'SNOWMASS', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SNOWDP, 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,EVLAND, 'EVLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PRLAND, 'PRLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SNOLAND, 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DRPARLAND, 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DFPARLAND, 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LHSNOW, 'LHSNOW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SWNETSNOW1, 'SWNETSNOW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LWUPSNOW, 'LWUPSNOW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LWDNSNOW, 'LWDNSNOW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TCSORIG, 'TCSORIG' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TPSN1IN, 'TPSN1IN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TPSN1OUT, 'TPSN1OUT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LHLAND, 'LHLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SHLAND, 'SHLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SWLAND, 'SWLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SWDOWNLAND, 'SWDOWNLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,LWLAND, 'LWLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,GHLAND, 'GHLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,GHSNOW, 'GHSNOW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,GHTSKIN,'GHTSKIN', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SMLAND, 'SMLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TWLAND, 'TWLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TELAND, 'TELAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,TSLAND, 'TSLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DWLAND, 'DWLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,DHLAND, 'DHLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SPLAND, 'SPLAND' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SPWATR, 'SPWATR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SPSNOW, 'SPSNOW' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNLAI, 'CNLAI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNTLAI, 'CNTLAI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNSAI, 'CNSAI' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNTOTC, 'CNTOTC' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNVEGC, 'CNVEGC' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNFROOTC,'CNFROOTC', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNNPP, 'CNNPP' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNGPP, 'CNGPP' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNSR, 'CNSR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNNEE, 'CNNEE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNXSMR, 'CNXSMR' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNADD, 'CNADD' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNLOSS, 'CNLOSS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNBURN, 'CNBURN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PARABS, 'PARABS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,PARINC, 'PARINC' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SCSAT, 'SCSAT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SCUNS, 'SCUNS' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,BTRANT, 'BTRANT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,SIF, 'SIF' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNCO2, 'CNCO2' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVAPOUT , 'EVAPOUT',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SUBLIM , 'SUBLIM' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHOUT , 'SHOUT' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RUNOFF , 'RUNOFF' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPINT , 'EVPINT' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPSOI , 'EVPSOI' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPVEG , 'EVPVEG' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPICE , 'EVPICE' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WAT10CM , 'WAT10CM',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WATSOI , 'WATSOI' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ICESOI , 'ICESOI' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVPSNO , 'EVPSNO' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,BFLOW , 'BASEFLOW',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RUNSURF , 'RUNSURF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SMELT , 'SMELT' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLWUP , 'HLWUP' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWNDSRF , 'SWNDSRF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWNDSRF , 'LWNDSRF',ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,HLATN , 'HLATN' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,QINFIL , 'QINFIL' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,AR1 , 'AR1' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,AR2 , 'AR2' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RZEQ , 'RZEQ' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHFLX , 'GHFLX' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSURF , 'TPSURF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSN1 , 'TPSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPUST , 'TPUNST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSAT , 'TPSAT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPWLT , 'TPWLT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ASNOW , 'ASNOW' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHSNOW , 'SHSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,AVETSNOW , 'AVETSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRSAT , 'FRSAT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRUST , 'FRUST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FRWLT , 'FRWLT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP1 , 'TP1' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP2 , 'TP2' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP3 , 'TP3' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP4 , 'TP4' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP5 , 'TP5' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TP6 , 'TP6' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EMIS , 'EMIS' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBVR , 'ALBVR' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBVF , 'ALBVF' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBNR , 'ALBNR' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ALBNF , 'ALBNF' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DELTS , 'DELTS' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DELQS , 'DELQS' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TST , 'TST' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,QST , 'QST' ,ALLOC=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LST , 'LST' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WET1 , 'WET1' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WET2 , 'WET2' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WET3 , 'WET3' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WCSF , 'WCSF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WCRZ , 'WCRZ' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WCPR , 'WCPR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,ACCUM , 'ACCUM' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOMAS , 'SNOWMASS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOWDP , 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,EVLAND , 'EVLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PRLAND , 'PRLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SNOLAND , 'SNOLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DRPARLAND , 'DRPARLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DFPARLAND , 'DFPARLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LHSNOW , 'LHSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWNETSNOW1 , 'SWNETSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWUPSNOW , 'LWUPSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWDNSNOW , 'LWDNSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TCSORIG , 'TCSORIG' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSN1IN , 'TPSN1IN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TPSN1OUT , 'TPSN1OUT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LHLAND , 'LHLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SHLAND , 'SHLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWLAND , 'SWLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SWDOWNLAND , 'SWDOWNLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,LWLAND , 'LWLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHLAND , 'GHLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHSNOW , 'GHSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,GHTSKIN , 'GHTSKIN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SMLAND , 'SMLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TWLAND , 'TWLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TELAND , 'TELAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,TSLAND , 'TSLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DWLAND , 'DWLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,DHLAND , 'DHLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SPLAND , 'SPLAND' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SPWATR , 'SPWATR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SPSNOW , 'SPSNOW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNLAI , 'CNLAI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNTLAI , 'CNTLAI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSAI , 'CNSAI' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNTOTC , 'CNTOTC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNVEGC , 'CNVEGC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFROOTC , 'CNFROOTC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNNPP , 'CNNPP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNGPP , 'CNGPP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNSR , 'CNSR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNNEE , 'CNNEE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNXSMR , 'CNXSMR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNADD , 'CNADD' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNLOSS , 'CNLOSS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNBURN , 'CNBURN' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PARABS , 'PARABS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,PARINC , 'PARINC' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SCSAT , 'SCSAT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SCUNS , 'SCUNS' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,BTRANT , 'BTRANT' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,SIF , 'SIF' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNCO2 , 'CNCO2' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNFIRE_CNT , 'CNFIRE_CNT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNSOM_CLOSS , 'CNSOM_CLOSS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNNDEPLOY , 'CNNDEPLOY' , RC=STATUS); VERIFY_(STATUS) @@ -5547,20 +5547,20 @@ subroutine Driver ( RC ) call MAPL_GetPointer(EXPORT,CNTOTLITC , 'CNTOTLITC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNCWDC , 'CNCWDC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT,CNROOT , 'CNROOT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,CNFSEL, 'CNFSEL' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU001,'RMELTDU001', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU002,'RMELTDU002', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU003,'RMELTDU003', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU004,'RMELTDU004', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTDU005,'RMELTDU005', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTBC001,'RMELTBC001', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTBC002,'RMELTBC002', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTOC001,'RMELTOC001', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,RMELTOC002,'RMELTOC002', RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,WATERTABLED,'WATERTABLED' RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT,FSWCHANGE, 'FSWCHANGE', RC=STATUS); VERIFY_(STATUS) - - IF (RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,CNFSEL , 'CNFSEL' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU001 ,'RMELTDU001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU002 ,'RMELTDU002' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU003 ,'RMELTDU003' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU004 ,'RMELTDU004' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTDU005 ,'RMELTDU005' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTBC001 ,'RMELTBC001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTBC002 ,'RMELTBC002' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTOC001 ,'RMELTOC001' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,RMELTOC002 ,'RMELTOC002' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,WATERTABLED ,'WATERTABLED' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT,FSWCHANGE ,'FSWCHANGE' , RC=STATUS); VERIFY_(STATUS) + + IF (RUN_IRRIG /= 0) call MAPL_GetPointer(EXPORT,IRRIGRATE ,'IRRIGRATE' , RC=STATUS); VERIFY_(STATUS) NTILES = size(PS) From af945376b15c80bb3f3c1a1964acc96e1f28cd0b Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 21 Dec 2021 17:32:00 -0500 Subject: [PATCH 28/66] bug fix --- .../GEOS_CatchCNCLM45GridComp.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 231244529..a77cd8e77 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -6495,10 +6495,10 @@ subroutine Driver ( RC ) ! gkw: obtain catchment area fractions and soil moisture ! ------------------------------------------------------ -call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & - srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc, & - SWSRF1OUT=SWSRF1, SWSRF2OUT=SWSRF2, SWSRF4OUT=SWSRF4 ) +call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & + srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc ) + ! obtain saturated canopy resistance following Farquhar, CLM4 implementation From d2daaad436535b10a764d8fd95e7313e27c4d5cc Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 28 Dec 2021 09:57:29 -0500 Subject: [PATCH 29/66] align list --- .../GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 index 73030e0bd..02061ce52 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 @@ -338,7 +338,7 @@ PROGRAM mkCatchParam inquire(file='clsm/ndvi.dat', exist=file_exists) if (.not.file_exists) call gimms_clim_ndvi (nc,nr,gridnamer) - write (log_file,'(a,a,a)')'Done computing ', trim(LAIBCS),' vegetation climatologies .............4' + write (log_file,'(a,a,a)')'Done computing ', trim(LAIBCS),' vegetation climatologies ............4' ! call modis_alb_on_tiles (nc,nr,ease_grid,regrid,gridnamet,gridnamer) ! call modis_scale_para (ease_grid,gridnamet) From 72155b750206d71ea141cbd58cb6e697ad21624b Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 28 Dec 2021 11:04:17 -0500 Subject: [PATCH 30/66] must be 3-character alphanumeric code, insted of NL4p we will have NL5 --- .../GEOSsurface_GridComp/Utils/Raster/make_bcs | 4 ++-- .../GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 | 4 ++-- .../GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs index 34c0502d4..2ac27f4e3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs @@ -143,6 +143,7 @@ echo " ${C2}GM4 -- for /discover/nobackup/ltakacs/bcs/Ganymed-4_0/ echo " ${C2}ICA -- for /discover/nobackup/ltakacs/bcs/Icarus/" echo " ${C2}NL3 -- for /discover/nobackup/ltakacs/bcs/Icarus-NLv3/" echo " ${C2}NL4 -- for /discover/nobackup/projects/gmao/smap/bcs_temporary/NLv4/" +echo " ${C2}NL5 -- in development for peat testing" echo " ${C2} equivalent parameter configuration and ancillary data." echo " " echo " NOTE: Due to compiler differences, code improvements and bug fixes that" @@ -151,13 +152,12 @@ echo " files produced by current source codes may differ with echo " Nevertheless, the impact of those differences on science is insignificant and" echo " the parameter files produced by current source codes can be considered as " echo " scientifically equivalent to achieved BCs" -echo " ${C2}NL4p -- in development for peat testing" echo " " echo " (OR press ENTER If you want to use the develop version of land BCs.)" set dummy = `echo $<` set dummy = `echo $dummy | tr "[:lower:]" "[:upper:]"` set lbcsv = DEF -if( $dummy == 'F25' | $dummy == 'GM4' | $dummy == 'ICA' | $dummy == 'NL3' | $dummy == 'NL4' | $dummy == 'NL4p') set lbcsv = $dummy +if( $dummy == 'F25' | $dummy == 'GM4' | $dummy == 'ICA' | $dummy == 'NL3' | $dummy == 'NL4' | $dummy == 'NL5' ) set lbcsv = $dummy ####################################################################### diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 index 02061ce52..52fa4db44 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 @@ -9,7 +9,7 @@ PROGRAM mkCatchParam ! -y: Size of latitude dimension of input raster. DEFAULT: 4320 ! -b: position of the dateline in the first box. DEFAULT: DC ! -g: Gridname (name of the .til or .rst file without file extension) -! -v: LBCSV : use a configuration from GEOS5 bcs directory ICA, NL3, NL4, or NL4p +! -v: LBCSV : use a configuration from GEOS5 bcs directory ICA, NL3, NL4, or NL5 ! -e: EASE : This is optional if catchment.def file is available already or ! the til file format is pre-Fortuna-2. ! @@ -105,7 +105,7 @@ PROGRAM mkCatchParam USAGE(5) =" -b: Position of the dateline in the first grid box (DC or DE). DEFAULT: DC " USAGE(6) =" -e: EASE : This is optional if catchment.def file is available already or " USAGE(7) =" the til file format is pre-Fortuna-2. " - USAGE(8) =" -v LBCSV : use a configuration from GEOS5 bcs directory F25, GM4, ICA, NL3, NL4, or NL4p " + USAGE(8) =" -v LBCSV : use a configuration from GEOS5 bcs directory F25, GM4, ICA, NL3, NL4, or NL5 " ! Process Arguments !------------------ diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 index 8edc887b9..66bed296b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 @@ -109,7 +109,7 @@ SUBROUTINE init_bcs_config (LBSV) process_peat = .false. jpl_height = .true. - case ("NL4p") + case ("NL5") LAIBCS = 'MODGEO' SOILBCS = 'HWSD' MODALB = 'MODIS2' From bae955a9c660bf6ff34d385ca36005f5ddf1951f Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Wed, 29 Dec 2021 16:28:49 -0500 Subject: [PATCH 31/66] fix for RSURFP2 --- .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index a85c15d1e..b107147af 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -2406,8 +2406,8 @@ SUBROUTINE energy4 ( & INTEGER ChNo, N REAL, DIMENSION(NCH) :: DEDEA, DHSDEA, EM, ESATTC, DESDTC, EA, RC, & - DRCDTC, DRCDEA, SWSRF4 - REAL DELTC, DELEA + DRCDTC, DRCDEA + REAL DELTC, DELEA, SWSRF4 !**** DATA DELTC /0.01/, DELEA /0.001/ @@ -2460,7 +2460,7 @@ SUBROUTINE energy4 ( & ENDDO CALL RSURFP2 ( & - NCH, UM, RDC, SWSRF, ESATTC, EA, WPWET, & + NCH, UM, RDC, SWSRF4, ESATTC, EA, WPWET, & RC, & RX1, RX2 & ) From f3b5184888669a0248ba818bd55c8aa69f71fedf Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Wed, 29 Dec 2021 16:36:11 -0500 Subject: [PATCH 32/66] typo --- .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index b107147af..d454f4cc9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -2406,8 +2406,8 @@ SUBROUTINE energy4 ( & INTEGER ChNo, N REAL, DIMENSION(NCH) :: DEDEA, DHSDEA, EM, ESATTC, DESDTC, EA, RC, & - DRCDTC, DRCDEA - REAL DELTC, DELEA, SWSRF4 + DRCDTC, DRCDEA, SWSRF4 + REAL DELTC, DELEA !**** DATA DELTC /0.01/, DELEA /0.001/ From 0d7740e82dfa23412839b546019007e47798acd0 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Wed, 29 Dec 2021 19:09:36 -0500 Subject: [PATCH 33/66] missing poros limit --- .../Utils/Raster/rmTinyCatchParaMod.F90 | 2 +- .../Utils/mk_restarts/Scale_Catch.F90 | 9 +++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 index 66bed296b..670eca210 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 @@ -3880,7 +3880,7 @@ SUBROUTINE create_model_para_woesten (Maskfile) tsa1(n),tsa2(n),tsb1(n),tsb2(n) & ) - if(soil_class_com(n) == 253) then + if(POROS(n) >= 0.8) then ! Michel Bechtold paper - PEATCLSM_fitting_CLSM_params.R produced these data values. if(process_peat) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index 59813cb4e..998bf2df8 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -393,6 +393,15 @@ end subroutine calc_soil_moist endif + ! PEAT CLSM - ensure low CATDEF on peat tiles + ! ------------------------------------------- + + where (catch(sca)%poros .gt. 0.90) + catch(sca)%catdef = 100. + catch(sca)%rzexc = 0. + catch(sca)%srfexc = 0. + end where + ! Write Scaled Catch ! ------------------ if (filetype ==0) then From cb481da69acd2647959b7dee9ecb3eda2dd696ba Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Wed, 29 Dec 2021 21:35:06 -0500 Subject: [PATCH 34/66] handle division by zero --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 3 ++- .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 3 ++- .../Utils/mk_restarts/Scale_CatchCN.F90 | 10 ++++++++++ 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index ba5652f3d..1242b1e9a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -798,7 +798,8 @@ SUBROUTINE CATCHCN ( & T1(1) = TG1(N)-TF T1(2) = TG2(N)-TF T1(3) = TG4(N)-TF - AREA(1)= AR1(N) + ! MB: to handle division by zero in PEATCLSM equations + AREA(1)= amax1(AR1(N),2.E-20) AREA(2)= AR2(N) AREA(3)= AR4(N) pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index d454f4cc9..af00c5194 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -830,7 +830,8 @@ SUBROUTINE CATCHMENT ( & T1(1) = TC1(N)-TF T1(2) = TC2(N)-TF T1(3) = TC4(N)-TF - AREA(1)= AR1(N) + ! MB: to handle division by zero in PEATCLSM equations + AREA(1)= amax1(AR1(N),2.E-20) AREA(2)= AR2(N) AREA(3)= AR4(N) pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index d4fbcb67c..f73a22145 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -422,6 +422,16 @@ end subroutine calc_soil_moist endif + ! PEAT CLSM - ensure low CATDEF on peat tiles + ! ------------------------------------------- + + where (catch(sca)%poros .gt. 0.90) + catch(sca)%catdef = 100. + catch(sca)%rzexc = 0. + catch(sca)%srfexc = 0. + end where + + ! Write Scaled Catch ! ------------------ if (filetype ==0) then From ec943c28a66dcf27787cc276089a26cc1885157f Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Wed, 29 Dec 2021 21:40:37 -0500 Subject: [PATCH 35/66] double check this --- .../GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 index 670eca210..66bed296b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 @@ -3880,7 +3880,7 @@ SUBROUTINE create_model_para_woesten (Maskfile) tsa1(n),tsa2(n),tsb1(n),tsb2(n) & ) - if(POROS(n) >= 0.8) then + if(soil_class_com(n) == 253) then ! Michel Bechtold paper - PEATCLSM_fitting_CLSM_params.R produced these data values. if(process_peat) then From 3647896252d54c72458c5e38811a85b30387d664 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 4 Jan 2022 10:54:14 -0500 Subject: [PATCH 36/66] bug fix --- .../Utils/mk_restarts/Scale_CatchCN.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index f73a22145..5f6535b7f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -171,13 +171,13 @@ end subroutine calc_soil_moist ! ------------------------------- read(arg(3),'(a)') fname3 - call MAPL_NCIOGetFileType(fname1, filetype,rc=rc) + call MAPL_NCIOGetFileType(fname1, filetype,__RC__) if (filetype == 0) then - call formatter(1)%open(trim(fname1),pFIO_READ,rc=rc) - call formatter(2)%open(trim(fname2),pFIO_READ,rc=rc) - cfg(1)=formatter(1)%read(rc=rc) - cfg(2)=formatter(2)%read(rc=rc) + call formatter(1)%open(trim(fname1),pFIO_READ,__RC__) + call formatter(2)%open(trim(fname2),pFIO_READ,__RC__) + cfg(1)=formatter(1)%read(__RC__) + cfg(2)=formatter(2)%read(__RC__) ! else ! open(unit=10, file=trim(fname1), form='unformatted') ! open(unit=20, file=trim(fname2), form='unformatted') @@ -203,8 +203,8 @@ end subroutine calc_soil_moist if (filetype ==0) then - ntiles = cfg(1)%get_dimension('tile',rc=rc) - un_dim3 = cfg(1)%get_dimension('unknown_dim3',rc=rc) + ntiles = cfg(1)%get_dimension('tile',__RC__) + un_dim3 = cfg(1)%get_dimension('unknown_dim3',__RC__) if(un_dim3 == 105) then clm45 = .true. VAR_COL = VAR_COL_CLM45 @@ -436,8 +436,8 @@ end subroutine calc_soil_moist ! ------------------ if (filetype ==0) then cfg(3) = cfg(2) - call formatter(3)%create(fname3,rc=rc) - call formatter(3)%write(cfg(3),rc=rc) + call formatter(3)%create(fname3,__RC__) + call formatter(3)%write(cfg(3),__RC__) call writecatchcn_nc4 ( catch(sca), formatter(3) ,cfg(3) ) ! else ! call writecatchcn ( 30,catch(sca) ) From 0233ea0bbdfa2179898a571870106323385d8446 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Sun, 9 Jan 2022 13:49:24 -0500 Subject: [PATCH 37/66] bug fix for CatchCN_CLM 4.5 BCS's file format --- .../Utils/Raster/mod_process_hres_data.F90 | 2 +- .../Utils/mk_restarts/Scale_CatchCN.F90 | 27 ++++++++++--------- .../Utils/mk_restarts/mk_GEOSldasRestarts.F90 | 6 ++++- 3 files changed, 21 insertions(+), 14 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 index 74e8c80c0..8b5a6aab9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 @@ -5754,7 +5754,7 @@ SUBROUTINE CLM45_fixed_parameters (nc,nr,gfiler) if(count_pix(i,3) > 0.) abm_int = NINT(abm (i) / count_pix(i,3)) if(count_pix(i,4) > 0.) hdm_r = hdm (i) / count_pix(i,4) - write (10,'(2I10, i3, f8.4, f8.2, f10.2, f8.4)' ) tid, cid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(sc_com) + write (10,'(2I8, i3, f8.4, f8.2, f10.2, f8.4)' ) tid, cid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(sc_com) end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index 5f6535b7f..8eafc077f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -150,6 +150,7 @@ end subroutine calc_soil_moist type(Filemetadata) :: cfg(3) integer :: i, rc, filetype integer :: status + character(256) :: Iam = "Scale_CatchCN" ! Usage ! ----- if (iargc() /= 6) then @@ -171,13 +172,13 @@ end subroutine calc_soil_moist ! ------------------------------- read(arg(3),'(a)') fname3 - call MAPL_NCIOGetFileType(fname1, filetype,__RC__) + call MAPL_NCIOGetFileType(fname1, filetype, rc=rc) if (filetype == 0) then - call formatter(1)%open(trim(fname1),pFIO_READ,__RC__) - call formatter(2)%open(trim(fname2),pFIO_READ,__RC__) - cfg(1)=formatter(1)%read(__RC__) - cfg(2)=formatter(2)%read(__RC__) + call formatter(1)%open(trim(fname1),pFIO_READ, rc=rc) + call formatter(2)%open(trim(fname2),pFIO_READ, rc=rc) + cfg(1)=formatter(1)%read(rc=rc) + cfg(2)=formatter(2)%read(rc=rc) ! else ! open(unit=10, file=trim(fname1), form='unformatted') ! open(unit=20, file=trim(fname2), form='unformatted') @@ -203,8 +204,8 @@ end subroutine calc_soil_moist if (filetype ==0) then - ntiles = cfg(1)%get_dimension('tile',__RC__) - un_dim3 = cfg(1)%get_dimension('unknown_dim3',__RC__) + ntiles = cfg(1)%get_dimension('tile', rc=rc) + un_dim3 = cfg(1)%get_dimension('unknown_dim3', rc=rc) if(un_dim3 == 105) then clm45 = .true. VAR_COL = VAR_COL_CLM45 @@ -246,6 +247,7 @@ end subroutine calc_soil_moist ! call readcatchcn ( 20,catch(new) ) end if + ! Create Scaled Catch ! ------------------- sca = 3 @@ -434,10 +436,11 @@ end subroutine calc_soil_moist ! Write Scaled Catch ! ------------------ + if (filetype ==0) then - cfg(3) = cfg(2) - call formatter(3)%create(fname3,__RC__) - call formatter(3)%write(cfg(3),__RC__) + cfg(3)=cfg(2) + call formatter(3)%create(fname3, rc=rc) + call formatter(3)%write(cfg(3), rc=rc) call writecatchcn_nc4 ( catch(sca), formatter(3) ,cfg(3) ) ! else ! call writecatchcn ( 30,catch(sca) ) @@ -538,7 +541,7 @@ end subroutine allocatch subroutine readcatchcn_nc4 (catch,formatter,cfg, rc) type(catch_rst) catch type(Filemetadata) :: cfg - type(Netcdf4_Fileformatter) :: formatter + type(Netcdf4_fileformatter) :: formatter integer, optional, intent(out) :: rc integer :: j, dim1,dim2 type(Variable), pointer :: myVariable @@ -1090,7 +1093,7 @@ subroutine calc_soil_moist( & ! calculate root zone equilibrium moisture for given catchment deficit call rzequil( & - ncat, catdef, vgwmax, & + ncat, catdef, vgwmax, & cdcr1, cdcr2, wpwet, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, & arw1, arw2, arw3, arw4, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 index c14e8cbd6..f079a37eb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 @@ -201,7 +201,11 @@ PROGRAM mk_GEOSldasRestarts stop endif - if (index(model,'45') /=0) clm45 = .true. + if (index(model,'45') /=0) then + clm45 = .true. + VAR_COL = VAR_COL_CLM45 + VAR_PFT = VAR_PFT_CLM45 + endif catch_scaler = 'Scale_CatchCN' else catch_scaler = 'Scale_Catch' From cd9112b1bdd7a6b32b0dae3ce900d8f0e3046d37 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Tue, 25 Jan 2022 14:01:37 -0500 Subject: [PATCH 38/66] these changes will be updated with separate PR --- .../GEOSsurface_GridComp/Utils/Raster/make_bcs | 3 +-- .../GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 | 6 +++--- .../Utils/Raster/mod_process_hres_data.F90 | 2 +- .../Utils/Raster/rmTinyCatchParaMod.F90 | 2 +- 4 files changed, 6 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs index 2ac27f4e3..d8b17283b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/make_bcs @@ -143,7 +143,6 @@ echo " ${C2}GM4 -- for /discover/nobackup/ltakacs/bcs/Ganymed-4_0/ echo " ${C2}ICA -- for /discover/nobackup/ltakacs/bcs/Icarus/" echo " ${C2}NL3 -- for /discover/nobackup/ltakacs/bcs/Icarus-NLv3/" echo " ${C2}NL4 -- for /discover/nobackup/projects/gmao/smap/bcs_temporary/NLv4/" -echo " ${C2}NL5 -- in development for peat testing" echo " ${C2} equivalent parameter configuration and ancillary data." echo " " echo " NOTE: Due to compiler differences, code improvements and bug fixes that" @@ -157,7 +156,7 @@ echo " (OR press ENTER If you want to use the develop version of la set dummy = `echo $<` set dummy = `echo $dummy | tr "[:lower:]" "[:upper:]"` set lbcsv = DEF -if( $dummy == 'F25' | $dummy == 'GM4' | $dummy == 'ICA' | $dummy == 'NL3' | $dummy == 'NL4' | $dummy == 'NL5' ) set lbcsv = $dummy +if( $dummy == 'F25' | $dummy == 'GM4' | $dummy == 'ICA' | $dummy == 'NL3' | $dummy == 'NL4' | $dummy == 'NL4p') set lbcsv = $dummy ####################################################################### diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 index 52fa4db44..73030e0bd 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 @@ -9,7 +9,7 @@ PROGRAM mkCatchParam ! -y: Size of latitude dimension of input raster. DEFAULT: 4320 ! -b: position of the dateline in the first box. DEFAULT: DC ! -g: Gridname (name of the .til or .rst file without file extension) -! -v: LBCSV : use a configuration from GEOS5 bcs directory ICA, NL3, NL4, or NL5 +! -v: LBCSV : use a configuration from GEOS5 bcs directory ICA, NL3, NL4, or NL4p ! -e: EASE : This is optional if catchment.def file is available already or ! the til file format is pre-Fortuna-2. ! @@ -105,7 +105,7 @@ PROGRAM mkCatchParam USAGE(5) =" -b: Position of the dateline in the first grid box (DC or DE). DEFAULT: DC " USAGE(6) =" -e: EASE : This is optional if catchment.def file is available already or " USAGE(7) =" the til file format is pre-Fortuna-2. " - USAGE(8) =" -v LBCSV : use a configuration from GEOS5 bcs directory F25, GM4, ICA, NL3, NL4, or NL5 " + USAGE(8) =" -v LBCSV : use a configuration from GEOS5 bcs directory F25, GM4, ICA, NL3, NL4, or NL4p " ! Process Arguments !------------------ @@ -338,7 +338,7 @@ PROGRAM mkCatchParam inquire(file='clsm/ndvi.dat', exist=file_exists) if (.not.file_exists) call gimms_clim_ndvi (nc,nr,gridnamer) - write (log_file,'(a,a,a)')'Done computing ', trim(LAIBCS),' vegetation climatologies ............4' + write (log_file,'(a,a,a)')'Done computing ', trim(LAIBCS),' vegetation climatologies .............4' ! call modis_alb_on_tiles (nc,nr,ease_grid,regrid,gridnamet,gridnamer) ! call modis_scale_para (ease_grid,gridnamet) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 index 8b5a6aab9..74e8c80c0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 @@ -5754,7 +5754,7 @@ SUBROUTINE CLM45_fixed_parameters (nc,nr,gfiler) if(count_pix(i,3) > 0.) abm_int = NINT(abm (i) / count_pix(i,3)) if(count_pix(i,4) > 0.) hdm_r = hdm (i) / count_pix(i,4) - write (10,'(2I8, i3, f8.4, f8.2, f10.2, f8.4)' ) tid, cid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(sc_com) + write (10,'(2I10, i3, f8.4, f8.2, f10.2, f8.4)' ) tid, cid, abm_int, peatf_r, gdp_r, hdm_r, field_cap(sc_com) end do diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 index 66bed296b..8edc887b9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 @@ -109,7 +109,7 @@ SUBROUTINE init_bcs_config (LBSV) process_peat = .false. jpl_height = .true. - case ("NL5") + case ("NL4p") LAIBCS = 'MODGEO' SOILBCS = 'HWSD' MODALB = 'MODIS2' From 9daf5a0924f40e114632097384a7d8f8d42305a9 Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Wed, 26 Jan 2022 12:52:42 -0500 Subject: [PATCH 39/66] typo --- .../GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index b3ad1c1a8..068833881 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -2709,7 +2709,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FSWCHANGE' + SHORT_NAME = 'FSWCHANGE' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) From 646ede4b9fcd2054016339abee11332996d8b57d Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 26 Jan 2022 18:44:56 -0500 Subject: [PATCH 40/66] cleanup of peat code: - reordered subroutine arguments for consistency - renamed/explained porosity threshold for PEATCLSM physics - added decimal point to hardcoded real numbers - white space and indent cleanup --- .../GEOS_SurfaceGridComp.F90 | 22 ++--- .../GEOS_CatchCNCLM40GridComp.F90 | 8 +- .../GEOS_CatchCNCLM45GridComp.F90 | 6 +- .../Shared/catchmentCN.F90 | 91 ++++++++++--------- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 6 +- .../GEOScatch_GridComp/catchment.F90 | 85 +++++++++-------- .../Shared/catch_constants.f90 | 16 +++- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 74 +++++++-------- .../Utils/mk_restarts/Scale_Catch.F90 | 6 +- .../Utils/mk_restarts/Scale_CatchCN.F90 | 6 +- 10 files changed, 170 insertions(+), 150 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index 068833881..ec1fc9805 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -7559,17 +7559,17 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) if(associated(ROC002)) call MAPL_LocStreamTransform( LOCSTREAM,ROC002(:,:,N) ,ROC002TILE(:,N), RC=STATUS); VERIFY_(STATUS) END DO - if(associated(RMELTDU001))call MAPL_LocStreamTransform( LOCSTREAM,RMELTDU001 ,RMELTDU001TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(RMELTDU002))call MAPL_LocStreamTransform( LOCSTREAM,RMELTDU002 ,RMELTDU002TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(RMELTDU003))call MAPL_LocStreamTransform( LOCSTREAM,RMELTDU003 ,RMELTDU003TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(RMELTDU004))call MAPL_LocStreamTransform( LOCSTREAM,RMELTDU004 ,RMELTDU004TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(RMELTDU005))call MAPL_LocStreamTransform( LOCSTREAM,RMELTDU005 ,RMELTDU005TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(RMELTBC001))call MAPL_LocStreamTransform( LOCSTREAM,RMELTBC001 ,RMELTBC001TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(RMELTBC002))call MAPL_LocStreamTransform( LOCSTREAM,RMELTBC002 ,RMELTBC002TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(RMELTOC001))call MAPL_LocStreamTransform( LOCSTREAM,RMELTOC001 ,RMELTOC001TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(RMELTOC002))call MAPL_LocStreamTransform( LOCSTREAM,RMELTOC002 ,RMELTOC002TILE, RC=STATUS); VERIFY_(STATUS) - if(associated(WATERTABLED))call MAPL_LocStreamTransform( LOCSTREAM,WATERTABLED ,WATERTABLEDTILE, RC=STATUS); VERIFY_(STATUS) - if(associated(FSWCHANGE ))call MAPL_LocStreamTransform( LOCSTREAM,FSWCHANGE ,FSWCHANGETILE , RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTDU001 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTDU001 ,RMELTDU001TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTDU002 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTDU002 ,RMELTDU002TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTDU003 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTDU003 ,RMELTDU003TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTDU004 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTDU004 ,RMELTDU004TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTDU005 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTDU005 ,RMELTDU005TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTBC001 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTBC001 ,RMELTBC001TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTBC002 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTBC002 ,RMELTBC002TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTOC001 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTOC001 ,RMELTOC001TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(RMELTOC002 ))call MAPL_LocStreamTransform(LOCSTREAM,RMELTOC002 ,RMELTOC002TILE, RC=STATUS); VERIFY_(STATUS) + if(associated(WATERTABLED))call MAPL_LocStreamTransform(LOCSTREAM,WATERTABLED,WATERTABLEDTILE,RC=STATUS); VERIFY_(STATUS) + if(associated(FSWCHANGE ))call MAPL_LocStreamTransform(LOCSTREAM,FSWCHANGE ,FSWCHANGETILE, RC=STATUS); VERIFY_(STATUS) if(associated(CNLAI)) then call MAPL_LocStreamTransform( LOCSTREAM,CNLAI ,CNLAITILE , RC=STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 1c3b11975..e63f7b7aa 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -3736,8 +3736,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'depth_to_water_table_from_surface',& - UNITS = 'm' ,& - SHORT_NAME = 'WATERTABLED' ,& + UNITS = 'm' ,& + SHORT_NAME = 'WATERTABLED' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) @@ -3746,7 +3746,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FSWCHANGE' ,& + SHORT_NAME = 'FSWCHANGE' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) @@ -7585,7 +7585,7 @@ subroutine Driver ( RC ) TSURF ,& SHSNOW1, AVETSNOW1, WAT10CM1, WATSOI1, ICESOI1 ,& LHSNOW1, LWUPSNOW1, LWDNSNOW1, NETSWSNOW ,& - TCSORIG1, TPSN1IN1, TPSN1OUT1,FSW_CHANGE ,& + TCSORIG1, TPSN1IN1, TPSN1OUT1, FSW_CHANGE ,& TC1_0=TC1_0, TC2_0=TC2_0, TC4_0=TC4_0 ,& QA1_0=QA1_0, QA2_0=QA2_0, QA4_0=QA4_0 ,& RCONSTIT=RCONSTIT, RMELT=RMELT, TOTDEPOS=TOTDEPOS, LHACC=LHACC) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index a77cd8e77..53f784c8c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -3673,8 +3673,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'depth_to_water_table_from_surface',& - UNITS = 'm' ,& - SHORT_NAME = 'WATERTABLED' ,& + UNITS = 'm' ,& + SHORT_NAME = 'WATERTABLED' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) @@ -3683,7 +3683,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FSWCHANGE' ,& + SHORT_NAME = 'FSWCHANGE' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 1242b1e9a..e19ffefa3 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -87,7 +87,7 @@ MODULE CATCHMENT_CN_MODEL SLOPE => CATCH_SNWALB_SLOPE, & MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & - SHR, SCONST, C_CANOP, N_sm, SATCAPFR , POROS_HighLat + SHR, SCONST, C_CANOP, N_sm, SATCAPFR , POROS_THRESHOLD_PEATCLSM USE SURFPARAMS, ONLY: CSOIL_2, RSWILT, & LAND_FIX, FLWALPHA @@ -956,9 +956,9 @@ SUBROUTINE CATCHCN ( & TG4SN=TPSNB(N) ENDIF - TG1(N)=TG1SF(N)*(1-AREASC)+TG1SN*AREASC - TG2(N)=TG2SF(N)*(1-AREASC)+TG2SN*AREASC - TG4(N)=TG4SF(N)*(1-AREASC)+TG4SN*AREASC + TG1(N)=TG1SF(N)*(1.-AREASC)+TG1SN*AREASC + TG2(N)=TG2SF(N)*(1.-AREASC)+TG2SN*AREASC + TG4(N)=TG4SF(N)*(1.-AREASC)+TG4SN*AREASC @@ -970,9 +970,9 @@ SUBROUTINE CATCHCN ( & DTC2SN=TPSN1(N)-TC2(N) DTC4SN=TPSN1(N)-TC4(N) - TC1(N)=TC1SF(N)*(1-AREASC)+TPSN1(N)*AREASC - TC2(N)=TC2SF(N)*(1-AREASC)+TPSN1(N)*AREASC - TC4(N)=TC4SF(N)*(1-AREASC)+TPSN1(N)*AREASC + TC1(N)=TC1SF(N)*(1.-AREASC)+TPSN1(N)*AREASC + TC2(N)=TC2SF(N)*(1.-AREASC)+TPSN1(N)*AREASC + TC4(N)=TC4SF(N)*(1.-AREASC)+TPSN1(N)*AREASC ! TC1(N)=TC1SF(N)*(1-AREASC)+TC1_ORIG(N)*AREASC ! TC2(N)=TC2SF(N)*(1-AREASC)+TC2_ORIG(N)*AREASC @@ -1083,13 +1083,14 @@ SUBROUTINE CATCHCN ( & !**** REMOVE EVAPORATED WATER FROM SURFACE RESERVOIRS: CALL WUPDAT ( & - NCH, DTSTEP, BF1, BF2, & + NCH, DTSTEP, & EVAPFR, SATCAP, TG1, RA1, RC, & AR1,AR2,AR4,CDCR1, ESATFR, & RZEQOL,SRFMN,WPWET,VGWMAX, POROS, & + BF1, BF2, ARS1, ARS2, ARS3, & CAPAC, RZEXC, CATDEF, SRFEXC, & ESOI, EVEG, EINT, & - ECORR, ARS1,ARS2,ARS3 & + ECORR & ) !**** UPDATE SENSIBLE HEAT IF WATER LIMITATIONS WERE IMPOSED: @@ -1111,9 +1112,10 @@ SUBROUTINE CATCHCN ( & !**** REDISTRIBUTE MOISTURE BETWEEN RESERVOIRS: CALL RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET,BF1,BF2, & - tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & - CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ARS1,ARS2,ARS3 & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET, & + tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros, & + BF1, BF2, ARS1, ARS2, ARS3, BUG, & + CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF & ) ! --------------------------------------------------------------------- @@ -1126,8 +1128,8 @@ SUBROUTINE CATCHCN ( & CALL BASE ( & NCH, DTSTEP,BF1, BF2, BF3, CDCR1, FRICE, COND, GNU,AR1, POROS,& - CATDEF, & - BFLOW,ars1,ars2,ars3 & + ARS1, ARS2, ARS3, & + CATDEF, BFLOW & ) ! --------------------------------------------------------------------- @@ -1151,10 +1153,10 @@ SUBROUTINE CATCHCN ( & !**** DETERMINE SURFACE RUNOFF AND INFILTRATION RATES: - CALL SRUNOFF ( NCH,DTSTEP,UFW4RO, FWETC, FWETL, & - AR1,ar2,ar4,THRUL, THRUC,frice,tp1,srfmx,BUG, & - VGWMAX,RZEQOL,POROS, & - SRFEXC,RUNSRF,RZEXC, & + CALL SRUNOFF ( NCH, DTSTEP, UFW4RO, FWETC, FWETL, & + AR1, AR2, AR4, THRUL, THRUC, FRICE, TP1, SRFMX, BUG, & + VGWMAX, RZEQOL, POROS, & + SRFEXC, RZEXC, RUNSRF, & QINFIL & ) @@ -1277,7 +1279,7 @@ SUBROUTINE CATCHCN ( & !FSW_CHANGE IS THE CHANGE IN THE FREE-STANDING WATER, RELEVANT FOR PEATLAND ONLY FSW_CHANGE(N) = 0. - IF(POROS(N) >= POROS_HighLat) THEN + IF(POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) FSW_CHANGE(N) = PR - EVAP(N) - RUNOFF(N) - WCHANGE(N) ENDIF @@ -1645,9 +1647,10 @@ END SUBROUTINE CATCHCN !**** =================================================== SUBROUTINE RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQ,AR1,WPWET,BF1, BF2, & - tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & - CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ars1,ars2,ars3 & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQ,AR1,WPWET, & + tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros, & + BF1, BF2, ARS1, ARS2, ARS3, BUG, & + CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF & ) !----------------------------------------------------------------- @@ -1662,18 +1665,19 @@ SUBROUTINE RZDRAIN ( & INTEGER, INTENT(IN) :: NCH REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: VGWMAX, SATCAP, RZEQ, AR1, wpwet, & - tsa1, tsa2, tsb1, tsb2, atau, btau, CDCR2, poros, BF1, BF2, ars1, ars2, ars3 + tsa1, tsa2, tsb1, tsb2, atau, btau, CDCR2, poros, & + BF1, BF2, ars1, ars2, ars3 LOGICAL, INTENT(IN) :: BUG REAL, INTENT(INOUT), DIMENSION(NCH) :: RZEXC, SRFEXC, CATDEF, CAPAC, & - RUNSRF + RUNSRF INTEGER N REAL srflw,rzflw,FLOW,EXCESS,TSC0,tsc2,rzave,rz0,wanom,rztot, & - rzx,btaux,ax,bx,rzdif,ZBAR1, SYSOIL,RZFLW_CATDEF,EXCESS_CATDEF, & - CATDEF_PEAT_THRESHOLD,RZFLW_AR1, AR1eq + rzx,btaux,ax,bx,rzdif,ZBAR1, SYSOIL,RZFLW_CATDEF,EXCESS_CATDEF, & + CATDEF_PEAT_THRESHOLD,RZFLW_AR1, AR1eq !**** - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1742,12 +1746,12 @@ SUBROUTINE RZDRAIN ( & RZFLW=CATDEF(N)-CDCR2(N) end if - IF (POROS(N) < POROS_HighLat) THEN + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN CATDEF(N)=CATDEF(N)-RZFLW RZEXC(N)=RZEXC(N)-RZFLW ELSE !MB2021: use AR1eq, equilibrium assumption between water level in soil hummocks and surface water level in hollows - AR1eq = (1+ars1(n)*(catdef(n)))/(1+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) + AR1eq = (1.+ars1(n)*(catdef(n)))/(1.+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) ! PEAT ! MB: accounting for water ponding on AR1 ! RZFLOW is partitioned into two flux components: (1) going in/out ponding water volume and (1) going in/out unsaturated soil storage @@ -1764,9 +1768,9 @@ SUBROUTINE RZDRAIN ( & ! (linear) approximation with the bf1-bf2-CLSM function, ! theoretical SYSOIL curve levels off approximately at 0 m and 0.45 m. ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) - SYSOIL = (2*bf1(n)*amin1(amax1(zbar1,0.),0.45) + 2*bf1(n)*bf2(n))/1000. + SYSOIL = (2.*bf1(n)*amin1(amax1(zbar1,0.),0.45) + 2.*bf1(n)*bf2(n))/1000. ! Calculate fraction of RZFLW removed/added to catdef - RZFLW_CATDEF = (1-AR1eq)*SYSOIL*RZFLW/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + RZFLW_CATDEF = (1.-AR1eq)*SYSOIL*RZFLW/(1.*AR1eq+SYSOIL*(1.-AR1eq)) CATDEF(N)=CATDEF(N)-RZFLW_CATDEF ! MB: remove all RZFLW from RZEXC because the other part ! flows into the surface water storage (microtopgraphy) @@ -1785,17 +1789,17 @@ SUBROUTINE RZDRAIN ( & EXCESS=RZEQ(N)+RZEXC(N)-VGWMAX(N) RZEXC(N)=VGWMAX(N)-RZEQ(N) - IF (POROS(N) < POROS_HighLat) THEN + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN CATDEF(N)=CATDEF(N)-EXCESS ELSE ! PEAT ! MB: like for RZFLW --> EXCESS_CATDEF is the fraction in/out of catdef - EXCESS_CATDEF=(1-AR1eq)*SYSOIL*EXCESS/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + EXCESS_CATDEF=(1.-AR1eq)*SYSOIL*EXCESS/(1.*AR1eq+SYSOIL*(1.-AR1eq)) CATDEF(N)=CATDEF(N)-EXCESS_CATDEF ENDIF ENDIF - IF (POROS(N) >= POROS_HighLat) THEN + IF (POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN ! MB: CATDEF Threshold at zbar=0 ! water table not allowed to rise higher (numerically instable) ! zbar<0 only occurred due to extreme infiltration rates @@ -2090,7 +2094,7 @@ SUBROUTINE FLUXES ( & DTC=DTCDRY+WETFRC*(DTCWET-DTCDRY) DTG=DTGDRY+WETFRC*(DTGWET-DTGDRY) DEA=DEADRY+WETFRC*(DEAWET-DEADRY) - ENBAL1=(1-FVEG(N))*SWNET(N) + FVEG(N)*(HLWTC + DHLWTC*DTC) + & + ENBAL1=(1.-FVEG(N))*SWNET(N) + FVEG(N)*(HLWTC + DHLWTC*DTC) + & (1.-FVEG(N))*HLWDWN(N) - (HLWTG + DHLWTC*DTG) - & DHDTG*(TG(N)-TC(N)) - & RHOTERM*ALHE*(ESATTC(N)+DESDTC(N)*(TG(N)-TCOLD) & @@ -2334,13 +2338,14 @@ END SUBROUTINE MATRIX_CALC !**** [ BEGIN WUPDAT ] !**** SUBROUTINE WUPDAT ( & - NCH, DTSTEP, BF1, BF2, & + NCH, DTSTEP, & EVAP, SATCAP, TC, RA, RC, & AR1,AR2,AR4,CDCR1, ESATFR, & RZEQ,SRFMN,WPWET,VGWMAX, POROS, & + BF1, BF2, ARS1, ARS2, ARS3, & CAPAC, RZEXC, CATDEF, SRFEXC, & EVROOT, EVSURF, EVINT, & - ECORR, ars1,ars2,ars3 & + ECORR & ) !**** !**** THIS SUBROUTINE ALLOWS EVAPOTRANSPIRATION TO ADJUST THE WATER @@ -2352,7 +2357,7 @@ SUBROUTINE WUPDAT ( & REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: EVAP, SATCAP, TC, RA, RC, AR1, & AR2, AR4, CDCR1, ESATFR, RZEQ, SRFMN, WPWET, VGWMAX, & - POROS, BF1, BF2, ars1, ars2, ars3 + POROS, BF1, BF2, ARS1, ARS2, ARS3 REAL, INTENT(INOUT), DIMENSION(NCH) :: CAPAC, RZEXC, CATDEF, & SRFEXC, EVROOT, EVSURF, EVINT @@ -2411,7 +2416,7 @@ SUBROUTINE WUPDAT ( & CAPAC(N) = AMAX1(0., CAPAC(N) - EVINT(N)*DTSTEP) RZEXC(N) = RZEXC(N) - EVROOT(N)*(1.-ESATFR(N))*DTSTEP SRFEXC(N) = SRFEXC(N) - EVSURF(N)*(1.-ESATFR(N))*DTSTEP - IF (POROS(N) < POROS_HighLat) THEN + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN CATDEF(N) = CATDEF(N) + (EVSURF(N) + EVROOT(N))*ESATFR(N)*DTSTEP ! 05.12.98: FIRST ATTEMPT TO INCLUDE BEDROCK ELSE @@ -2420,11 +2425,11 @@ SUBROUTINE WUPDAT ( & ! same approach as for RZFLW (see subroutine RZDRAIN for ! comments) ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) - SYSOIL = (2*bf1(N)*amin1(amax1(zbar1,0.),0.45) + 2*bf1(N)*bf2(N))/1000. + SYSOIL = (2.*bf1(N)*amin1(amax1(zbar1,0.),0.45) + 2.*bf1(N)*bf2(N))/1000. SYSOIL = amin1(SYSOIL,poros(N)) - ET_CATDEF = SYSOIL*(EVSURF(N) + EVROOT(N))*ESATFR(N)/(1.0*AR1(N)+SYSOIL*(1-AR1(N))) - AR1eq = (1+ars1(N)*(catdef(N)))/(1+ars2(N)*(catdef(N))+ars3(N)*(catdef(N))**2) - CATDEF(N) = CATDEF(N) + (1-AR1eq)*ET_CATDEF + ET_CATDEF = SYSOIL*(EVSURF(N) + EVROOT(N))*ESATFR(N)/(1.*AR1(N)+SYSOIL*(1.-AR1(N))) + AR1eq = (1.+ars1(N)*(catdef(N)))/(1.+ars2(N)*(catdef(N))+ars3(N)*(catdef(N))**2) + CATDEF(N) = CATDEF(N) + (1.-AR1eq)*ET_CATDEF ENDIF ELSE CAPAC(N) = AMAX1(0., CAPAC(N) - EVINT(N)*DTSTEP) @@ -2549,7 +2554,7 @@ subroutine gndtmp_cn(poros, zbar, ht, xfice, tp, FICE) ! this routine. do l=1,N_GT zb(l+1)=zb(l)-DZGT(l) - shc(l)=SHR0*(1-phi)*DZGT(l) + shc(l)=SHR0*(1.-phi)*DZGT(l) enddo diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index d9a044151..31a95f3cf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -2683,8 +2683,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'depth_to_water_table_from_surface',& - UNITS = 'm' ,& - SHORT_NAME = 'WATERTABLED' ,& + UNITS = 'm' ,& + SHORT_NAME = 'WATERTABLED' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) @@ -2693,7 +2693,7 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'change_in_free_surface_water_reservoir_on_peat',& UNITS = 'kg m-2 s-1' ,& - SHORT_NAME = 'FSWCHANGE' ,& + SHORT_NAME = 'FSWCHANGE' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index af00c5194..42b375513 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -87,7 +87,7 @@ MODULE CATCHMENT_MODEL SLOPE => CATCH_SNWALB_SLOPE, & MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & - SHR, SCONST, CSOIL_1, N_sm, SATCAPFR, POROS_HighLat + SHR, SCONST, CSOIL_1, N_sm, SATCAPFR, POROS_THRESHOLD_PEATCLSM USE SURFPARAMS, ONLY: & LAND_FIX, ASTRFR, STEXP, RSWILT, & @@ -993,9 +993,9 @@ SUBROUTINE CATCHMENT ( & - TC1(N)=TC1SF(N)*(1-AREASC)+TC1SN*AREASC - TC2(N)=TC2SF(N)*(1-AREASC)+TC2SN*AREASC - TC4(N)=TC4SF(N)*(1-AREASC)+TC4SN*AREASC + TC1(N)=TC1SF(N)*(1.-AREASC)+TC1SN*AREASC + TC2(N)=TC2SF(N)*(1.-AREASC)+TC2SN*AREASC + TC4(N)=TC4SF(N)*(1.-AREASC)+TC4SN*AREASC EVSNOW(N)=EVSN esno(n)=evsnow(n)*asnow(n)*DTSTEP ! to have esno in mm/20min (03-17-99) @@ -1108,11 +1108,12 @@ SUBROUTINE CATCHMENT ( & CALL WUPDAT ( & - NCH, DTSTEP,BF1, BF2, EVAPFR, SATCAP, TC1, RA1, RC, & + NCH, DTSTEP, EVAPFR, SATCAP, TC1, RA1, RC, & RX11,RX21,RX12,RX22,RX14,RX24, & AR1,AR2,AR4,CDCR1,EIRFRC,RZEQOL,srfmn,WPWET,VGWMAX,POROS, & + BF1, BF2, ARS1, ARS2, ARS3, & CAPAC, RZEXC, CATDEF, SRFEXC, & - EINT, ESOI, EVEG, ARS1,ARS2,ARS3 & + EINT, ESOI, EVEG & ) ! --------------------------------------------------------------------- @@ -1124,9 +1125,10 @@ SUBROUTINE CATCHMENT ( & !**** REDISTRIBUTE MOISTURE BETWEEN RESERVOIRS: CALL RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET,BF1, BF2, & - tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & - CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ars1,ars2,ars3 & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQOL,AR1,WPWET, & + tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros, & + BF1, BF2, ARS1, ARS2, ARS3, BUG, & + CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF & ) ! --------------------------------------------------------------------- @@ -1139,8 +1141,8 @@ SUBROUTINE CATCHMENT ( & CALL BASE ( & NCH, DTSTEP,BF1, BF2, BF3, CDCR1, FRICE, COND, GNU,AR1, POROS,& - CATDEF, & - BFLOW, ars1,ars2,ars3 & + ARS1, ARS2, ARS3, & + CATDEF, BFLOW & ) ! --------------------------------------------------------------------- @@ -1164,10 +1166,10 @@ SUBROUTINE CATCHMENT ( & !**** DETERMINE SURFACE RUNOFF AND INFILTRATION RATES: - CALL SRUNOFF ( NCH,DTSTEP,UFW4RO, FWETC, FWETL, & - AR1,ar2,ar4,THRUL, THRUC,frice,tp1,srfmx,BUG, & - VGWMAX,RZEQOL,POROS, & - SRFEXC,RUNSRF,RZEXC, & + CALL SRUNOFF ( NCH, DTSTEP, UFW4RO, FWETC, FWETL, & + AR1, AR2, AR4, THRUL, THRUC, FRICE, TP1, SRFMX, BUG, & + VGWMAX, RZEQOL, POROS, & + SRFEXC, RZEXC, RUNSRF, & QINFIL & ) @@ -1290,7 +1292,7 @@ SUBROUTINE CATCHMENT ( & !FSW_CHANGE IS THE CHANGE IN THE FREE-STANDING WATER, RELEVANT FOR PEATLAND ONLY FSW_CHANGE(N) = 0. - IF(POROS(N) >= POROS_HighLat) THEN + IF(POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) FSW_CHANGE(N) = PR - EVAP(N) - RUNOFF(N) - WCHANGE(N) ENDIF @@ -1668,9 +1670,10 @@ END SUBROUTINE CATCHMENT !**** =================================================== SUBROUTINE RZDRAIN ( & - NCH,DTSTEP,VGWMAX,SATCAP,RZEQ,AR1,WPWET,BF1, BF2, & - tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros,BUG, & - CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF,ars1,ars2,ars3 & + NCH,DTSTEP,VGWMAX,SATCAP,RZEQ,AR1,WPWET, & + tsa1,tsa2,tsb1,tsb2,atau,btau,CDCR2,poros, & + BF1, BF2, ARS1, ARS2, ARS3, BUG, & + CAPAC,RZEXC,SRFEXC,CATDEF,RUNSRF & ) !----------------------------------------------------------------- @@ -1685,16 +1688,17 @@ SUBROUTINE RZDRAIN ( & INTEGER, INTENT(IN) :: NCH REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: VGWMAX, SATCAP, RZEQ, AR1, wpwet, & - tsa1, tsa2, tsb1, tsb2, atau, btau, CDCR2, poros, BF1, BF2, ars1, ars2, ars3 + tsa1, tsa2, tsb1, tsb2, atau, btau, CDCR2, poros, & + BF1, BF2, ars1, ars2, ars3 LOGICAL, INTENT(IN) :: BUG REAL, INTENT(INOUT), DIMENSION(NCH) :: RZEXC, SRFEXC, CATDEF, CAPAC, & - RUNSRF - + RUNSRF + INTEGER N REAL srflw,rzflw,FLOW,EXCESS,TSC0,tsc2,rzave,rz0,wanom,rztot, & - rzx,btaux,ax,bx,rzdif, rzavemin,ZBAR1,SYSOIL,RZFLW_CATDEF, & + rzx,btaux,ax,bx,rzdif, rzavemin,ZBAR1,SYSOIL,RZFLW_CATDEF, & EXCESS_CATDEF, CATDEF_PEAT_THRESHOLD, RZFLW_AR1, AR1eq @@ -1780,13 +1784,13 @@ SUBROUTINE RZDRAIN ( & RZFLW=CATDEF(N)-CDCR2(N) end if - IF (POROS(N) < POROS_HighLat) then + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) then ! mineral soil CATDEF(N)=CATDEF(N)-RZFLW RZEXC(N)=RZEXC(N)-RZFLW else !MB2021: use AR1eq, equilibrium assumption between water level in soil hummocks and surface water level in hollows - AR1eq = (1+ars1(n)*(catdef(n)))/(1+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) + AR1eq = (1.+ars1(n)*(catdef(n)))/(1.+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) ! PEAT ! MB: accounting for water ponding on AR1 ! RZFLOW is partitioned into two flux components: (1) going in/out ponding water volume and (1) going in/out unsaturated soil storage @@ -1803,10 +1807,10 @@ SUBROUTINE RZDRAIN ( & ! (linear) approximation with the bf1-bf2-CLSM function, ! theoretical SYSOIL curve levels off approximately at 0 m and 0.45 m. ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) - SYSOIL = (2*bf1(n)*amin1(amax1(zbar1,0.),0.45) + 2*bf1(n)*bf2(n))/1000. + SYSOIL = (2.*bf1(n)*amin1(amax1(zbar1,0.),0.45) + 2.*bf1(n)*bf2(n))/1000. SYSOIL = amin1(SYSOIL,poros(n)) ! Calculate fraction of RZFLW removed/added to catdef - RZFLW_CATDEF = (1-AR1eq)*SYSOIL*RZFLW/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + RZFLW_CATDEF = (1.-AR1eq)*SYSOIL*RZFLW/(1.*AR1eq+SYSOIL*(1.-AR1eq)) CATDEF(N)=CATDEF(N)-RZFLW_CATDEF ! MB: remove all RZFLW from RZEXC because the other part ! flows into the surface water storage (microtopgraphy) @@ -1826,17 +1830,17 @@ SUBROUTINE RZDRAIN ( & EXCESS=RZEQ(N)+RZEXC(N)-VGWMAX(N) RZEXC(N)=VGWMAX(N)-RZEQ(N) - IF (POROS(N) < POROS_HighLat) THEN + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN CATDEF(N)=CATDEF(N)-EXCESS ELSE ! PEAT ! MB: like for RZFLW --> EXCESS_CATDEF is the fraction in/out of catdef - EXCESS_CATDEF=(1-AR1eq)*SYSOIL*EXCESS/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + EXCESS_CATDEF=(1.-AR1eq)*SYSOIL*EXCESS/(1.*AR1eq+SYSOIL*(1.-AR1eq)) CATDEF(N)=CATDEF(N)-EXCESS_CATDEF ENDIF ENDIF - IF (POROS(N) >= POROS_HighLat) THEN + IF (POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN ! MB: CATDEF Threshold at zbar=0 ! water table not allowed to rise higher (numerically instable) ! zbar<0 only occurred due to extreme infiltration rates @@ -2435,8 +2439,8 @@ SUBROUTINE energy4 ( & DEDEA(CHNO) = DEDQA(CHNO) * EPSILON / PSUR(CHNO) DHSDEA(CHNO) = DHSDQA(CHNO) * EPSILON / PSUR(CHNO) - IF (POROS(CHNO) < POROS_HighLat) THEN - ! mineral soil + IF (POROS(CHNO) < POROS_THRESHOLD_PEATCLSM) THEN + ! mineral soil SWSRF4(CHNO) = SWSRF(CHNO) ELSE ! PEAT @@ -2810,11 +2814,12 @@ END SUBROUTINE TMPFAC !**** [ BEGIN WUPDAT ] !**** SUBROUTINE WUPDAT ( & - NCH, DTSTEP, BF1, BF2, EVAP, SATCAP, TC, RA, RC, & + NCH, DTSTEP, EVAP, SATCAP, TC, RA, RC, & RX11,RX21,RX12,RX22,RX14,RX24, AR1,AR2,AR4,CDCR1, & EIRFRC,RZEQ,srfmn,WPWET,VGWMAX, POROS, & + BF1, BF2, ARS1, ARS2, ARS3, & CAPAC, RZEXC, CATDEF, SRFEXC, & - EINT, ESOI, EVEG,ars1,ars2,ars3 & + EINT, ESOI, EVEG & ) !**** !**** THIS SUBROUTINE ALLOWS EVAPOTRANSPIRATION TO ADJUST THE WATER @@ -2827,7 +2832,7 @@ SUBROUTINE WUPDAT ( & REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: EVAP, SATCAP, TC, RA, RC, RX11, & RX21, RX12, RX22, RX14, RX24, AR1, AR2, AR4, CDCR1, EIRFRC, & - RZEQ, srfmn, WPWET, VGWMAX, POROS, BF1, BF2, ars1,ars2,ars3 + RZEQ, srfmn, WPWET, VGWMAX, POROS, BF1, BF2, ARS1, ARS2, ARS3 REAL, INTENT(INOUT), DIMENSION(NCH) :: CAPAC, CATDEF, RZEXC, SRFEXC @@ -2923,7 +2928,7 @@ SUBROUTINE WUPDAT ( & RZEXC(CHNO) = RZEXC(CHNO) - EVEG(CHNO)*(1.-ESATFR) SRFEXC(CHNO) = SRFEXC(CHNO) - ESOI(CHNO)*(1.-ESATFR) - IF (POROS(CHNO) < POROS_HighLat) THEN + IF (POROS(CHNO) < POROS_THRESHOLD_PEATCLSM) THEN CATDEF(CHNO) = CATDEF(CHNO) + (ESOI(CHNO) + EVEG(CHNO))*ESATFR ELSE ! PEAT @@ -2931,11 +2936,11 @@ SUBROUTINE WUPDAT ( & ! same approach as for RZFLW (see subroutine RZDRAIN for ! comments) ZBAR1=SQRT(1.e-20+CATDEF(CHNO)/BF1(CHNO))-BF2(CHNO) - SYSOIL = (2*bf1(CHNO)*amin1(amax1(zbar1,0.),0.45) + 2*bf1(CHNO)*bf2(CHNO))/1000. + SYSOIL = (2.*bf1(CHNO)*amin1(amax1(zbar1,0.),0.45) + 2.*bf1(CHNO)*bf2(CHNO))/1000. SYSOIL = amin1(SYSOIL,poros(CHNO)) - ET_CATDEF = SYSOIL*(ESOI(CHNO) + EVEG(CHNO))*ESATFR/(1.0*AR1(CHNO)+SYSOIL*(1-AR1(CHNO))) - AR1eq = (1+ars1(chno)*(catdef(chno)))/(1+ars2(chno)*(catdef(chno))+ars3(chno)*(catdef(chno))**2) - CATDEF(CHNO) = CATDEF(CHNO) + (1-AR1eq)*ET_CATDEF + ET_CATDEF = SYSOIL*(ESOI(CHNO) + EVEG(CHNO))*ESATFR/(1.*AR1(CHNO)+SYSOIL*(1.-AR1(CHNO))) + AR1eq = (1.+ars1(chno)*(catdef(chno)))/(1.+ars2(chno)*(catdef(chno))+ars3(chno)*(catdef(chno))**2) + CATDEF(CHNO) = CATDEF(CHNO) + (1.-AR1eq)*ET_CATDEF ENDIF ! 05.12.98: first attempt to include bedrock ELSE diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 index 06c7c1e8f..d15631fb3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 @@ -44,7 +44,7 @@ module catch_constants INTEGER, PARAMETER, PUBLIC :: N_Pfaf_Catchs = 291284 ! # of Pfafstetter hydrological catchements in the globe INTEGER, PARAMETER, PUBLIC :: N_Pfaf_LandCatchs = 290188 ! # of Pfafstetter hydrological catchments used within - ! the runoff routing model (excluding submerged catchments) + ! the runoff routing model (excluding submerged catchments) ! --------------------------------------------------------------------------- @@ -85,7 +85,17 @@ module catch_constants REAL, PARAMETER, PUBLIC :: SATCAPFR = 0.2 ! SATCAP = SATCAPFR * LAI ! peatCLSM implementation smahanam 3-16-2021 - - REAL, PARAMETER, PUBLIC :: POROS_HighLat = 0.9 + ! + ! Use of peat-specific hydrology (PEATCLSM) is triggered by a porosity threshold. + ! Porosity of peat tiles depends on bcs version. + ! + ! bcs version | source of peat info | porosity + ! ----------------------------------------------------------------- + ! NLv3, NLv4 | HWSD | poros=0.80 + ! NLv5 | PEATMAP | poros=0.93 + ! + ! - reichle, 26 Jan 2022 + + REAL, PARAMETER, PUBLIC :: POROS_THRESHOLD_PEATCLSM = 0.90 end module catch_constants diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index ed779be76..4a3c21cb7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -48,7 +48,7 @@ MODULE lsm_routines MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & SHR, N_SM, SCONST, CSOIL_1, & - C_CANOP, SATCAPFR, POROS_HighLat + C_CANOP, SATCAPFR, POROS_THRESHOLD_PEATCLSM USE SURFPARAMS, ONLY: & LAND_FIX, CSOIL_2, WEMIN, AICEV, AICEN, & @@ -262,10 +262,10 @@ END SUBROUTINE INTERC !**** =================================================== SUBROUTINE SRUNOFF ( & - NCH,DTSTEP,UFW4RO, FWETC, FWETL, AR1,ar2,ar4, THRUL,THRUC, & - frice,tp1,srfmx, BUG, & - VGWMAX,RZEQ,POROS, & - SRFEXC,RUNSRF,RZEXC, & + NCH, DTSTEP, UFW4RO, FWETC, FWETL, & + AR1, AR2, AR4, THRUL, THRUC, FRICE, TP1, SRFMX, BUG, & + VGWMAX, RZEQ, POROS, & + SRFEXC, RZEXC, RUNSRF, & QINFIL & ) @@ -279,7 +279,7 @@ SUBROUTINE SRUNOFF ( & srfmx, THRUL, THRUC, VGWMAX, RZEQ, POROS LOGICAL, INTENT(IN) :: BUG - REAL, INTENT(INOUT), DIMENSION(NCH) :: SRFEXC ,RUNSRF, RZEXC + REAL, INTENT(INOUT), DIMENSION(NCH) :: SRFEXC, RZEXC, RUNSRF REAL, INTENT(OUT), DIMENSION(NCH) :: QINFIL @@ -295,7 +295,7 @@ SUBROUTINE SRUNOFF ( & PTOTAL=THRUL(N) + THRUC(N) - IF (POROS(N) < POROS_HighLat) THEN + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN ! Non-peatland frun=AR1(N) srun0=PTOTAL*frun @@ -367,7 +367,7 @@ SUBROUTINE SRUNOFF ( & if(UFW4RO) then !**** Compute runoff from large-scale and convective storms separately: - IF (POROS(N) < POROS_HighLat) THEN + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN !non-peatland deficit=srfmx(n)-srfexc(n) srunl=AR1(n)*THRUL(n) @@ -472,11 +472,10 @@ END SUBROUTINE SRUNOFF !**** ///////////////////////////////////////////////////////////////// !**** ----------------------------------------------------------------- !**** - SUBROUTINE BASE ( & - NCH,DTSTEP,BF1,BF2,BF3,CDCR1,FRICE,COND,GNU,AR1,POROS, & - CATDEF, & - BFLOW,ars1,ars2,ars3 & - ) + SUBROUTINE BASE ( & + NCH,DTSTEP,BF1,BF2,BF3,CDCR1,FRICE,COND,GNU,AR1,POROS,ars1,ars2,ars3, & + CATDEF,BFLOW & + ) IMPLICIT NONE @@ -496,10 +495,10 @@ SUBROUTINE BASE ( & data ashift/0./ - DO N=1,NCH + DO N=1,NCH ! note intentionally opposite sign w.r.t. zbar defined above, - reichle, 16 Nov 2015 ZBAR=SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) - IF (POROS(N) < POROS_HighLat) THEN + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN BFLOW(N)=(1.-FRICE(N))*1000.* & cond(n)*exp(-(bf3(n)-ashift)-gnu(n)*zbar)/gnu(n) ! *1000 is to convert from m/s to mm/s @@ -532,7 +531,7 @@ SUBROUTINE BASE ( & ! Ta in m2/s, BFLOW in mm/s Ta = (Ksz_zero*(1.+100.*amax1(0.,ZBAR))**(1.-m_Ivanov))/(100.*(m_Ivanov-1.)) BFLOW(N)=v_slope*Ta*1000. - ! handling numerical instability due to extrene snow melt events on partly frozen ground + ! handling numerical instability due to extreme snow melt events on partly frozen ground ! --> allow BFLOW/DISCHARGE for zbar .LE. 0.05 ICERAMP= AMAX1(0., AMIN1(1., ZBAR/0.05)) ICERAMP= 1.-ICERAMP*CFRICE @@ -544,11 +543,11 @@ SUBROUTINE BASE ( & ! MB: accounting for water ponding on AR1 ! same approach as for RZFLW (see subroutine RZDRAIN for ! comments) - SYSOIL = (2*bf1(N)*amin1(amax1(zbar,0.),0.45) + 2*bf1(N)*bf2(N))/1000. + SYSOIL = (2.*bf1(N)*amin1(amax1(zbar,0.),0.45) + 2.*bf1(N)*bf2(N))/1000. SYSOIL = amin1(SYSOIL,poros(n)) !MB2021: use AR1eq, equilibrium assumption between water level in soil hummocks and surface water level in hollows - AR1eq = (1+ars1(n)*(catdef(n)))/(1+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) - BFLOW_CATDEF = (1-AR1eq)*SYSOIL*BFLOW(N)/(1.0*AR1eq+SYSOIL*(1-AR1eq)) + AR1eq = (1.+ars1(n)*(catdef(n)))/(1.+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) + BFLOW_CATDEF = (1.-AR1eq)*SYSOIL*BFLOW(N)/(1.*AR1eq+SYSOIL*(1.-AR1eq)) CATDEF(N)=CATDEF(N)+BFLOW_CATDEF*dtstep ENDIF @@ -584,8 +583,9 @@ SUBROUTINE PARTITION ( & REAL, INTENT(IN) :: DTSTEP REAL, INTENT(IN), DIMENSION(NCH) :: DZSF,RZEXC,RZEQ,VGWMAX,CDCR1,CDCR2, & PSIS,BEE,poros,WPWET, & + BF1,BF2, & ars1,ars2,ars3,ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4,BF1,BF2 + arw1,arw2,arw3,arw4 LOGICAL, INTENT(IN) :: BUG ! ------------------------------------------------------------------- @@ -741,22 +741,22 @@ SUBROUTINE PARTITION ( & ENDIF - IF (POROS(N) >= POROS_HighLat) THEN - ! peat - ! MB: AR4 (wilting fraction) for peatland depending on water table depth - !ZBAR defined here positive below ground and in meter - ZBAR=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) - AR4(N)=amax1(0.,amin1(1.0,(ZBAR-0.30)/(1.0))) - ARREST = 1.0 - AR1(N) - AR4(N)=amin1(ARREST,AR4(N)) - AR2(N)=1.0-AR4(n)-AR1(N) - ENDIF + IF (POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN + ! peat + ! MB: AR4 (wilting fraction) for peatland depending on water table depth + !ZBAR defined here positive below ground and in meter + ZBAR=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + AR4(N)=amax1(0.,amin1(1.0,(ZBAR-0.30)/(1.0))) + ARREST = 1.0 - AR1(N) + AR4(N)=amin1(ARREST,AR4(N)) + AR2(N)=1.0-AR4(n)-AR1(N) + ENDIF RZI(N)=RZEQYI SWSRF1(N)=1. !mjs: changed .001 temporarily because of large bee. - IF (POROS(N) < POROS_HighLat) THEN + IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN SWSRF2(N)=AMIN1(1., AMAX1(0.01, RZEQYI)) SWSRF4(N)=AMIN1(1., AMAX1(0.01, WILT)) @@ -1013,7 +1013,7 @@ subroutine gndtp0(t1,phi,zbar,thetaf,ht,fh21w,fh21i,fh21d, & ! *********************************** ! lets get the thermal conductivity for the layers - a1=1-phi + a1=1.-phi tk1=1.01692+a1*(0.89865+1.06211*a1) xw=phi*(1.-fice(1)) a2=phi-xw @@ -1850,7 +1850,7 @@ subroutine gndtmp(dts,phi,zbar,thetaf,fh21,ht,xfice,tp, FICE) ! this routine. do l=1,N_GT zb(l+1)=zb(l)-DZGT(l) - shc(l)=shr0*(1-phi)*DZGT(l) + shc(l)=shr0*(1.-phi)*DZGT(l) enddo do l=1,N_GT zc(l)=0.5*(zb(l)+zb(l+1)) @@ -1922,7 +1922,7 @@ subroutine gndtmp(dts,phi,zbar,thetaf,fh21,ht,xfice,tp, FICE) do k=1,N_GT - a1=1-phi ! ROCK FRACTION + a1=1.-phi ! ROCK FRACTION tk1=1.01692+a1*(0.89865+1.06211*a1) xw=phi*(1.-fice(k)) ! FOR SATURATED SOIL, XW HERE IS ! THE LIQUID WATER FRACTION @@ -2034,7 +2034,7 @@ subroutine gndtmp(dts,phi,zbar,thetaf,fh21,ht,xfice,tp, FICE) xfice=xfice+fice(l) enddo - IF (phi < POROS_HighLat) THEN + IF (phi < POROS_THRESHOLD_PEATCLSM) THEN xfice=xfice/((N_GT+1)-lstart) ELSE !PEAT @@ -2104,7 +2104,7 @@ subroutine catch_calc_tp( NTILES, poros, ghtcnt, tp, fice ) do k=1,N_gt - shc(k) = shr0*(1-phi)*DZGT(k) + shc(k) = shr0*(1.-phi)*DZGT(k) ws = phi*DZGT(k) ! PORE SPACE IN LAYER @@ -2228,7 +2228,7 @@ subroutine catch_calc_ght( dzgt, poros, tp, fice, ghtcnt ) phi=PHIGT end if - shc = shr0*(1-phi)*DZGT + shc = shr0*(1.-phi)*DZGT ws = phi*DZGT ! PORE SPACE IN LAYER diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index 998bf2df8..5a8dbea32 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -3,8 +3,8 @@ program Scale_Catch use MAPL - use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT - USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT + use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT + USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, POROS_THRESHOLD_PEAT implicit none character(256) :: fname1, fname2, fname3 @@ -396,7 +396,7 @@ end subroutine calc_soil_moist ! PEAT CLSM - ensure low CATDEF on peat tiles ! ------------------------------------------- - where (catch(sca)%poros .gt. 0.90) + where (catch(sca)%poros >= POROS_THRESHOLD_PEAT) catch(sca)%catdef = 100. catch(sca)%rzexc = 0. catch(sca)%srfexc = 0. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index 8eafc077f..ed4eb182b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -2,8 +2,8 @@ #include "MAPL_Generic.h" program Scale_CatchCN use MAPL - use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT - USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT + use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT + USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, POROS_THRESHOLD_PEAT implicit none character(256) :: fname1, fname2, fname3 @@ -427,7 +427,7 @@ end subroutine calc_soil_moist ! PEAT CLSM - ensure low CATDEF on peat tiles ! ------------------------------------------- - where (catch(sca)%poros .gt. 0.90) + where (catch(sca)%poros >= POROS_THRESHOLD_PEAT) catch(sca)%catdef = 100. catch(sca)%rzexc = 0. catch(sca)%srfexc = 0. From 47f970cf0fc8fddc195ac3984409929ef5e5f9fc Mon Sep 17 00:00:00 2001 From: biljanaorescanin Date: Wed, 26 Jan 2022 19:43:21 -0500 Subject: [PATCH 41/66] fix bug I introduced --- .../GEOS_CatchCNCLM45GridComp.F90 | 4 +++- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 7 ++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 53f784c8c..52aac23e0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -6497,7 +6497,9 @@ subroutine Driver ( RC ) ! ------------------------------------------------------ call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & - srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc ) + srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc, & + SWSRF1OUT=SWSRF1, SWSRF2OUT=SWSRF2, SWSRF4OUT=SWSRF4 ) + ! obtain saturated canopy resistance following Farquhar, CLM4 implementation diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 4a3c21cb7..abd9371d6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -1535,7 +1535,8 @@ subroutine catch_calc_soil_moist( & srfexc,rzexc,catdef, & ar1, ar2, ar4, & sfmc, rzmc, prmc, & - werror, sfmcun, rzmcun, prmcun ) + werror, sfmcun, rzmcun, prmcun, & + swsrf1out, swsrf2out, swsrf4out ) ! Calculate diagnostic soil moisture content from prognostic ! excess/deficit variables. @@ -1601,6 +1602,7 @@ subroutine catch_calc_soil_moist( & real, dimension(NTILES), intent(out), optional :: sfmcun real, dimension(NTILES), intent(out), optional :: rzmcun real, dimension(NTILES), intent(out), optional :: prmcun + real, dimension(NTILES), intent(out), optional :: swsrf1out, swsrf2out, swsrf4out ! ---------------------------- ! @@ -1694,6 +1696,9 @@ subroutine catch_calc_soil_moist( & swsrf1,swsrf2,swsrf4,rzi & ) + if(present(swsrf1out)) swsrf1out = swsrf1 + if(present(swsrf2out)) swsrf2out = swsrf2 + if(present(swsrf4out)) swsrf4out = swsrf4 ! compute surface, root zone, and profile soil moisture From 23d71fc5cb400cb476f44f92503e926b97fdb6cb Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 26 Jan 2022 19:58:01 -0500 Subject: [PATCH 42/66] fixed minor bug introduced in previous commit (poros threshold for PEATCLSM) --- .../GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 | 4 ++-- .../GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index 5a8dbea32..e3f3f17ef 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -4,7 +4,7 @@ program Scale_Catch use MAPL use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT - USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, POROS_THRESHOLD_PEAT + USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, POROS_THRESHOLD_PEATCLSM implicit none character(256) :: fname1, fname2, fname3 @@ -396,7 +396,7 @@ end subroutine calc_soil_moist ! PEAT CLSM - ensure low CATDEF on peat tiles ! ------------------------------------------- - where (catch(sca)%poros >= POROS_THRESHOLD_PEAT) + where (catch(sca)%poros >= POROS_THRESHOLD_PEATCLSM) catch(sca)%catdef = 100. catch(sca)%rzexc = 0. catch(sca)%srfexc = 0. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index ed4eb182b..15d1ce62a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -3,7 +3,7 @@ program Scale_CatchCN use MAPL use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT - USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, POROS_THRESHOLD_PEAT + USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, POROS_THRESHOLD_PEATCLSM implicit none character(256) :: fname1, fname2, fname3 @@ -427,7 +427,7 @@ end subroutine calc_soil_moist ! PEAT CLSM - ensure low CATDEF on peat tiles ! ------------------------------------------- - where (catch(sca)%poros >= POROS_THRESHOLD_PEAT) + where (catch(sca)%poros >= POROS_THRESHOLD_PEATCLSM) catch(sca)%catdef = 100. catch(sca)%rzexc = 0. catch(sca)%srfexc = 0. From 538193b0419609ec87928a77fc52a62b30ccda2b Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 26 Jan 2022 21:29:26 -0500 Subject: [PATCH 43/66] additional cleanup: - introduced constant for max ZBAR in PEATCLSM specific yield calcs - changed name of PEATCLSM porosity threshold - white space changes --- .../Shared/catchmentCN.F90 | 20 +- .../GEOScatch_GridComp/catchment.F90 | 20 +- .../Shared/catch_constants.f90 | 22 +-- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 30 +-- .../Shared/SurfParams.F90 | 186 +++++++++--------- .../Utils/mk_restarts/Scale_Catch.F90 | 4 +- .../Utils/mk_restarts/Scale_CatchCN.F90 | 4 +- 7 files changed, 145 insertions(+), 141 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index e19ffefa3..91148b8d5 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -87,7 +87,9 @@ MODULE CATCHMENT_CN_MODEL SLOPE => CATCH_SNWALB_SLOPE, & MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & - SHR, SCONST, C_CANOP, N_sm, SATCAPFR , POROS_THRESHOLD_PEATCLSM + SHR, SCONST, C_CANOP, N_sm, SATCAPFR , & + PEATCLSM_POROS_THRESHOLD, & + PEATCLSM_ZBARMAX_4_SYSOIL USE SURFPARAMS, ONLY: CSOIL_2, RSWILT, & LAND_FIX, FLWALPHA @@ -1279,7 +1281,7 @@ SUBROUTINE CATCHCN ( & !FSW_CHANGE IS THE CHANGE IN THE FREE-STANDING WATER, RELEVANT FOR PEATLAND ONLY FSW_CHANGE(N) = 0. - IF(POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN + IF(POROS(N) >= PEATCLSM_POROS_THRESHOLD) THEN pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) FSW_CHANGE(N) = PR - EVAP(N) - RUNOFF(N) - WCHANGE(N) ENDIF @@ -1746,7 +1748,7 @@ SUBROUTINE RZDRAIN ( & RZFLW=CATDEF(N)-CDCR2(N) end if - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN CATDEF(N)=CATDEF(N)-RZFLW RZEXC(N)=RZEXC(N)-RZFLW ELSE @@ -1768,7 +1770,7 @@ SUBROUTINE RZDRAIN ( & ! (linear) approximation with the bf1-bf2-CLSM function, ! theoretical SYSOIL curve levels off approximately at 0 m and 0.45 m. ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) - SYSOIL = (2.*bf1(n)*amin1(amax1(zbar1,0.),0.45) + 2.*bf1(n)*bf2(n))/1000. + SYSOIL = (2.*bf1(n)*amin1(amax1(zbar1,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(n)*bf2(n))/1000. ! Calculate fraction of RZFLW removed/added to catdef RZFLW_CATDEF = (1.-AR1eq)*SYSOIL*RZFLW/(1.*AR1eq+SYSOIL*(1.-AR1eq)) CATDEF(N)=CATDEF(N)-RZFLW_CATDEF @@ -1789,9 +1791,9 @@ SUBROUTINE RZDRAIN ( & EXCESS=RZEQ(N)+RZEXC(N)-VGWMAX(N) RZEXC(N)=VGWMAX(N)-RZEQ(N) - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN CATDEF(N)=CATDEF(N)-EXCESS - ELSE + ELSE ! PEAT ! MB: like for RZFLW --> EXCESS_CATDEF is the fraction in/out of catdef EXCESS_CATDEF=(1.-AR1eq)*SYSOIL*EXCESS/(1.*AR1eq+SYSOIL*(1.-AR1eq)) @@ -1799,7 +1801,7 @@ SUBROUTINE RZDRAIN ( & ENDIF ENDIF - IF (POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) >= PEATCLSM_POROS_THRESHOLD) THEN ! MB: CATDEF Threshold at zbar=0 ! water table not allowed to rise higher (numerically instable) ! zbar<0 only occurred due to extreme infiltration rates @@ -2416,7 +2418,7 @@ SUBROUTINE WUPDAT ( & CAPAC(N) = AMAX1(0., CAPAC(N) - EVINT(N)*DTSTEP) RZEXC(N) = RZEXC(N) - EVROOT(N)*(1.-ESATFR(N))*DTSTEP SRFEXC(N) = SRFEXC(N) - EVSURF(N)*(1.-ESATFR(N))*DTSTEP - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN CATDEF(N) = CATDEF(N) + (EVSURF(N) + EVROOT(N))*ESATFR(N)*DTSTEP ! 05.12.98: FIRST ATTEMPT TO INCLUDE BEDROCK ELSE @@ -2425,7 +2427,7 @@ SUBROUTINE WUPDAT ( & ! same approach as for RZFLW (see subroutine RZDRAIN for ! comments) ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) - SYSOIL = (2.*bf1(N)*amin1(amax1(zbar1,0.),0.45) + 2.*bf1(N)*bf2(N))/1000. + SYSOIL = (2.*bf1(N)*amin1(amax1(zbar1,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(N)*bf2(N))/1000. SYSOIL = amin1(SYSOIL,poros(N)) ET_CATDEF = SYSOIL*(EVSURF(N) + EVROOT(N))*ESATFR(N)/(1.*AR1(N)+SYSOIL*(1.-AR1(N))) AR1eq = (1.+ars1(N)*(catdef(N)))/(1.+ars2(N)*(catdef(N))+ars3(N)*(catdef(N))**2) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 42b375513..768b189ad 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -87,7 +87,9 @@ MODULE CATCHMENT_MODEL SLOPE => CATCH_SNWALB_SLOPE, & MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & - SHR, SCONST, CSOIL_1, N_sm, SATCAPFR, POROS_THRESHOLD_PEATCLSM + SHR, SCONST, CSOIL_1, N_sm, SATCAPFR, & + PEATCLSM_POROS_THRESHOLD, & + PEATCLSM_ZBARMAX_4_SYSOIL USE SURFPARAMS, ONLY: & LAND_FIX, ASTRFR, STEXP, RSWILT, & @@ -1292,7 +1294,7 @@ SUBROUTINE CATCHMENT ( & !FSW_CHANGE IS THE CHANGE IN THE FREE-STANDING WATER, RELEVANT FOR PEATLAND ONLY FSW_CHANGE(N) = 0. - IF(POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN + IF(POROS(N) >= PEATCLSM_POROS_THRESHOLD) THEN pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) FSW_CHANGE(N) = PR - EVAP(N) - RUNOFF(N) - WCHANGE(N) ENDIF @@ -1784,7 +1786,7 @@ SUBROUTINE RZDRAIN ( & RZFLW=CATDEF(N)-CDCR2(N) end if - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) then + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) then ! mineral soil CATDEF(N)=CATDEF(N)-RZFLW RZEXC(N)=RZEXC(N)-RZFLW @@ -1807,7 +1809,7 @@ SUBROUTINE RZDRAIN ( & ! (linear) approximation with the bf1-bf2-CLSM function, ! theoretical SYSOIL curve levels off approximately at 0 m and 0.45 m. ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) - SYSOIL = (2.*bf1(n)*amin1(amax1(zbar1,0.),0.45) + 2.*bf1(n)*bf2(n))/1000. + SYSOIL = (2.*bf1(n)*amin1(amax1(zbar1,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(n)*bf2(n))/1000. SYSOIL = amin1(SYSOIL,poros(n)) ! Calculate fraction of RZFLW removed/added to catdef RZFLW_CATDEF = (1.-AR1eq)*SYSOIL*RZFLW/(1.*AR1eq+SYSOIL*(1.-AR1eq)) @@ -1830,7 +1832,7 @@ SUBROUTINE RZDRAIN ( & EXCESS=RZEQ(N)+RZEXC(N)-VGWMAX(N) RZEXC(N)=VGWMAX(N)-RZEQ(N) - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN CATDEF(N)=CATDEF(N)-EXCESS ELSE ! PEAT @@ -1840,7 +1842,7 @@ SUBROUTINE RZDRAIN ( & ENDIF ENDIF - IF (POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) >= PEATCLSM_POROS_THRESHOLD) THEN ! MB: CATDEF Threshold at zbar=0 ! water table not allowed to rise higher (numerically instable) ! zbar<0 only occurred due to extreme infiltration rates @@ -2439,7 +2441,7 @@ SUBROUTINE energy4 ( & DEDEA(CHNO) = DEDQA(CHNO) * EPSILON / PSUR(CHNO) DHSDEA(CHNO) = DHSDQA(CHNO) * EPSILON / PSUR(CHNO) - IF (POROS(CHNO) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(CHNO) < PEATCLSM_POROS_THRESHOLD) THEN ! mineral soil SWSRF4(CHNO) = SWSRF(CHNO) ELSE @@ -2928,7 +2930,7 @@ SUBROUTINE WUPDAT ( & RZEXC(CHNO) = RZEXC(CHNO) - EVEG(CHNO)*(1.-ESATFR) SRFEXC(CHNO) = SRFEXC(CHNO) - ESOI(CHNO)*(1.-ESATFR) - IF (POROS(CHNO) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(CHNO) < PEATCLSM_POROS_THRESHOLD) THEN CATDEF(CHNO) = CATDEF(CHNO) + (ESOI(CHNO) + EVEG(CHNO))*ESATFR ELSE ! PEAT @@ -2936,7 +2938,7 @@ SUBROUTINE WUPDAT ( & ! same approach as for RZFLW (see subroutine RZDRAIN for ! comments) ZBAR1=SQRT(1.e-20+CATDEF(CHNO)/BF1(CHNO))-BF2(CHNO) - SYSOIL = (2.*bf1(CHNO)*amin1(amax1(zbar1,0.),0.45) + 2.*bf1(CHNO)*bf2(CHNO))/1000. + SYSOIL = (2.*bf1(CHNO)*amin1(amax1(zbar1,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(CHNO)*bf2(CHNO))/1000. SYSOIL = amin1(SYSOIL,poros(CHNO)) ET_CATDEF = SYSOIL*(ESOI(CHNO) + EVEG(CHNO))*ESATFR/(1.*AR1(CHNO)+SYSOIL*(1.-AR1(CHNO))) AR1eq = (1.+ars1(chno)*(catdef(chno)))/(1.+ars2(chno)*(catdef(chno))+ars3(chno)*(catdef(chno))**2) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 index d15631fb3..37aa1ca57 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 @@ -70,18 +70,12 @@ module catch_constants REAL, PARAMETER, PUBLIC :: SHR = 2400. ! J/kg/K spec heat of rock ! [where "per kg" is something like ! "per kg of water equiv. density"] - REAL, PARAMETER, PUBLIC :: SCONST = 1.9E6/920. - ! Changed CSOIL_2 back to pre-MERRA value of 70,000 J/K. - ! This amounts to a change in the very definition of the surface temperature and - ! also shifts the layers for ground heat content (soil temperature) downward. - ! - reichle, 16 Nov 2015 + + REAL, PARAMETER, PUBLIC :: SCONST = 1.9E6/920. ! some snow constant + REAL, PARAMETER, PUBLIC :: CSOIL_1 = 70000. ! J/K - heat capacity associated w/ tsurf -! #ifdef LAND_UPD -! REAL, PARAMETER, PUBLIC :: CSOIL_2 = 70000. ! J/K - heat capacity associated w/ tsurf ! Post H5_0 -! #else -! REAL, PARAMETER, PUBLIC :: CSOIL_2 = 200. ! J/K - heat capacity associated w/ tsurf -! #endif - REAL, PARAMETER, PUBLIC :: C_CANOP = 200. ! J/K - heat capacity associated w/ tc + REAL, PARAMETER, PUBLIC :: C_CANOP = 200. ! J/K - heat capacity associated w/ tc (CatchCN) + REAL, PARAMETER, PUBLIC :: SATCAPFR = 0.2 ! SATCAP = SATCAPFR * LAI ! peatCLSM implementation smahanam 3-16-2021 @@ -96,6 +90,10 @@ module catch_constants ! ! - reichle, 26 Jan 2022 - REAL, PARAMETER, PUBLIC :: POROS_THRESHOLD_PEATCLSM = 0.90 + REAL, PARAMETER, PUBLIC :: PEATCLSM_THRESHOLD_POROS = 0.90 ! [m3/m3] + ! max zbar for specific yield calc in PEATCLSM + + REAL, PARAMETER, PUBLIC :: PEATCLSM_ZBARMAX_4_SYSOIL = 0.45 ! [m] + end module catch_constants diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index abd9371d6..b1ddfe274 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -48,7 +48,9 @@ MODULE lsm_routines MAXSNDEPTH => CATCH_MAXSNDEPTH, & DZ1MAX => CATCH_DZ1MAX, & SHR, N_SM, SCONST, CSOIL_1, & - C_CANOP, SATCAPFR, POROS_THRESHOLD_PEATCLSM + C_CANOP, SATCAPFR, & + PEATCLSM_POROS_THRESHOLD, & + PEATCLSM_ZBARMAX_4_SYSOIL USE SURFPARAMS, ONLY: & LAND_FIX, CSOIL_2, WEMIN, AICEV, AICEN, & @@ -91,8 +93,8 @@ MODULE lsm_routines ! --------------------------------------------------------------------------- ! - REAL, PARAMETER :: TIMFRL = 1.0 - REAL, PARAMETER :: TIMFRC = 0.333 + REAL, PARAMETER :: TIMFRL = 1.0 + REAL, PARAMETER :: TIMFRC = 0.333 ! --------------------------------------------------------------------------- ! @@ -121,14 +123,14 @@ MODULE lsm_routines ! ! constants for "landscape" freeze/thaw (FT) state (see subroutine catch_calc_FT()) - REAL, PARAMETER :: CATCH_FT_WEIGHT_TP1 = 0.5 ! - REAL, PARAMETER :: CATCH_FT_THRESHOLD_TEFF = TF ! [Kelvin] - REAL, PARAMETER :: CATCH_FT_THRESHOLD_ASNOW = 0.2 ! + REAL, PARAMETER :: CATCH_FT_WEIGHT_TP1 = 0.5 ! + REAL, PARAMETER :: CATCH_FT_THRESHOLD_TEFF = TF ! [Kelvin] + REAL, PARAMETER :: CATCH_FT_THRESHOLD_ASNOW = 0.2 ! REAL, PARAMETER :: ZERO = 0. REAL, PARAMETER :: ONE = 1. - CONTAINS +CONTAINS !**** !**** ----------------------------------------------------------------- @@ -295,7 +297,7 @@ SUBROUTINE SRUNOFF ( & PTOTAL=THRUL(N) + THRUC(N) - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN ! Non-peatland frun=AR1(N) srun0=PTOTAL*frun @@ -367,7 +369,7 @@ SUBROUTINE SRUNOFF ( & if(UFW4RO) then !**** Compute runoff from large-scale and convective storms separately: - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN !non-peatland deficit=srfmx(n)-srfexc(n) srunl=AR1(n)*THRUL(n) @@ -498,7 +500,7 @@ SUBROUTINE BASE ( & DO N=1,NCH ! note intentionally opposite sign w.r.t. zbar defined above, - reichle, 16 Nov 2015 ZBAR=SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN BFLOW(N)=(1.-FRICE(N))*1000.* & cond(n)*exp(-(bf3(n)-ashift)-gnu(n)*zbar)/gnu(n) ! *1000 is to convert from m/s to mm/s @@ -543,7 +545,7 @@ SUBROUTINE BASE ( & ! MB: accounting for water ponding on AR1 ! same approach as for RZFLW (see subroutine RZDRAIN for ! comments) - SYSOIL = (2.*bf1(N)*amin1(amax1(zbar,0.),0.45) + 2.*bf1(N)*bf2(N))/1000. + SYSOIL = (2.*bf1(N)*amin1(amax1(zbar,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(N)*bf2(N))/1000. SYSOIL = amin1(SYSOIL,poros(n)) !MB2021: use AR1eq, equilibrium assumption between water level in soil hummocks and surface water level in hollows AR1eq = (1.+ars1(n)*(catdef(n)))/(1.+ars2(n)*(catdef(n))+ars3(n)*(catdef(n))**2) @@ -741,7 +743,7 @@ SUBROUTINE PARTITION ( & ENDIF - IF (POROS(N) >= POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) >= PEATCLSM_POROS_THRESHOLD) THEN ! peat ! MB: AR4 (wilting fraction) for peatland depending on water table depth !ZBAR defined here positive below ground and in meter @@ -756,7 +758,7 @@ SUBROUTINE PARTITION ( & SWSRF1(N)=1. !mjs: changed .001 temporarily because of large bee. - IF (POROS(N) < POROS_THRESHOLD_PEATCLSM) THEN + IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN SWSRF2(N)=AMIN1(1., AMAX1(0.01, RZEQYI)) SWSRF4(N)=AMIN1(1., AMAX1(0.01, WILT)) @@ -2039,7 +2041,7 @@ subroutine gndtmp(dts,phi,zbar,thetaf,fh21,ht,xfice,tp, FICE) xfice=xfice+fice(l) enddo - IF (phi < POROS_THRESHOLD_PEATCLSM) THEN + IF (phi < PEATCLSM_POROS_THRESHOLD) THEN xfice=xfice/((N_GT+1)-lstart) ELSE !PEAT diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 index 3e2398649..1ed10273f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Shared/SurfParams.F90 @@ -2,23 +2,23 @@ !========================================================== module SurfParams - + ! Justin, 12 Apr 2018 - Created - Replaces LAND_UPD ifdefs , added SurfParams_init, ! called from GEOS_LandGridCompMod, GEOS_LandiceGridCompMod ! jkolassa, 11 Jun 2020 - added LSM_CHOICE as input; introduced separate land parameter collections ! use MAPL_ExceptionHandling implicit none - + private - + public :: SurfParams_init - + ! --------------------------------------------------------------------------- ! Switch for catchment physics parameters ! --------------------------------------------------------------------------- - - + + ! Variables set by SurfParams_init: REAL, PUBLIC, SAVE :: CSOIL_2 ! J/K - heat capacity associated w/ tsurf REAL, PUBLIC, SAVE :: WEMIN ! kg/m^2 minimum SWE in areal fraction @@ -26,113 +26,113 @@ module SurfParams REAL, PUBLIC, SAVE :: FLWALPHA ! SRFLW multiplier with SRFLW < 0 REAL, PUBLIC, SAVE :: ASTRFR, STEXP ! stress parameters in energy2 REAL, PUBLIC, SAVE :: RSWILT ! parameters in rsurfp - + LOGICAL, PUBLIC, SAVE :: LAND_FIX ! Used for fixes and init changes that ! are still default in Icarus GCM - contains - +contains + ! Call to get "constants" that really are variables changeable during land/landice initialization - + subroutine SurfParams_init(LAND_PARAMS,LSM_CHOICE, rc) - + implicit none - + CHARACTER(*), INTENT(IN) :: LAND_PARAMS INTEGER, INTENT(IN) :: LSM_CHOICE INTEGER, OPTIONAL, INTENT(OUT) :: rc - + LOGICAL, SAVE :: init_called = .FALSE. ! Flag if SurfParams_init has been called - + ! --------------------------------------------------------------------------- - + if (init_called) then ! already called !write (*,*) "SurfParams_init being called again" return end if - + if (LSM_CHOICE==1) then - - select case (LAND_PARAMS) - case ("Icarus") ! "Old" LDASsa physics, current default for Icarus GCM - LAND_FIX = .FALSE. - CSOIL_2 = 200. - WEMIN = 26. - AICEV = 0.149 - AICEN = 19.851 - FLWALPHA = 1. ! i.e., FLWALPHA unchanged - ASTRFR = 0.333 - STEXP = 1. - RSWILT = 500. - - case ("V24_C05") ! V24_C05 changes, default for LDAS m4-17-0 - LAND_FIX = .TRUE. - CSOIL_2 = 70000. ! Post H5_0 - WEMIN = 13. - AICEV = 0.107 - AICEN = 19.893 - FLWALPHA = 0.01 - ASTRFR = 1. - STEXP = 2. - RSWILT = 2000. - - case ("NRv7.2") ! SMAP NRv7.2 changes, default for after LDAS m4-17-6 - LAND_FIX = .TRUE. - CSOIL_2 = 70000. ! Post H5_0 - WEMIN = 13. - AICEV = 0.149 - AICEN = 19.851 - FLWALPHA = 0.04 - ASTRFR = 0.333 ! reverted - STEXP = 1. ! reverted - RSWILT = 500. ! reverted - - case DEFAULT - _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') - end select - + + select case (LAND_PARAMS) + case ("Icarus") ! "Old" LDASsa physics, current default for Icarus GCM + LAND_FIX = .FALSE. + CSOIL_2 = 200. + WEMIN = 26. + AICEV = 0.149 + AICEN = 19.851 + FLWALPHA = 1. ! i.e., FLWALPHA unchanged + ASTRFR = 0.333 + STEXP = 1. + RSWILT = 500. + + case ("V24_C05") ! V24_C05 changes, default for LDAS m4-17-0 + LAND_FIX = .TRUE. + CSOIL_2 = 70000. ! Post H5_0 + WEMIN = 13. + AICEV = 0.107 + AICEN = 19.893 + FLWALPHA = 0.01 + ASTRFR = 1. + STEXP = 2. + RSWILT = 2000. + + case ("NRv7.2") ! SMAP NRv7.2 changes, default for after LDAS m4-17-6 + LAND_FIX = .TRUE. + CSOIL_2 = 70000. ! Post H5_0 + WEMIN = 13. + AICEV = 0.149 + AICEN = 19.851 + FLWALPHA = 0.04 + ASTRFR = 0.333 ! reverted + STEXP = 1. ! reverted + RSWILT = 500. ! reverted + + case DEFAULT + _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') + end select + else if (LSM_CHOICE==2) then - - select case (LAND_PARAMS) - case ("CN_CLM40") ! parameters to reproduce Fanwei Zeng's Catchment-CN.4.0 runs (e0004s_transientCO2_05) done with build /gpfsm/dnb31/fzeng/LDASsa_m3-16_0_p2_CatchCatchCN_for_MERRA3 - LAND_FIX = .TRUE. - CSOIL_2 = 70000. ! Post H5_0 - WEMIN = 13. - AICEV = 0.149 - AICEN = 19.851 - FLWALPHA = 1. - ASTRFR = 0.333 ! reverted - STEXP = 1. ! reverted - RSWILT = 1500. - - case DEFAULT - _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') - end select - - else if (LSM_CHOICE==3) then - select case (LAND_PARAMS) - - case ("CN_CLM45") ! parameters to reproduce Eunjee Lee's Catchment-CN4.5 fire carbon emission simulations - LAND_FIX = .TRUE. - CSOIL_2 = 70000. ! Post H5_0 - WEMIN = 13. - AICEV = 0.107 - AICEN = 19.893 - FLWALPHA = 0.005 - ASTRFR = 0.333 ! reverted - STEXP = 1. ! reverted - RSWILT = 2000. - - case DEFAULT - _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') - end select + + select case (LAND_PARAMS) + case ("CN_CLM40") ! parameters to reproduce Fanwei Zeng's Catchment-CN.4.0 runs (e0004s_transientCO2_05) done with build /gpfsm/dnb31/fzeng/LDASsa_m3-16_0_p2_CatchCatchCN_for_MERRA3 + LAND_FIX = .TRUE. + CSOIL_2 = 70000. ! Post H5_0 + WEMIN = 13. + AICEV = 0.149 + AICEN = 19.851 + FLWALPHA = 1. + ASTRFR = 0.333 ! reverted + STEXP = 1. ! reverted + RSWILT = 1500. + + case DEFAULT + _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') + end select + + else if (LSM_CHOICE==3) then + select case (LAND_PARAMS) + + case ("CN_CLM45") ! parameters to reproduce Eunjee Lee's Catchment-CN4.5 fire carbon emission simulations + LAND_FIX = .TRUE. + CSOIL_2 = 70000. ! Post H5_0 + WEMIN = 13. + AICEV = 0.107 + AICEN = 19.893 + FLWALPHA = 0.005 + ASTRFR = 0.333 ! reverted + STEXP = 1. ! reverted + RSWILT = 2000. + + case DEFAULT + _ASSERT(.FALSE.,'LAND_PARAMS not valid or incompatible with LSM_CHOICE') + end select else - _ASSERT(.FALSE.,'land model choice not valid') + _ASSERT(.FALSE.,'land model choice not valid') end if ! LSM_CHOICE - + init_called = .TRUE. _RETURN(_SUCCESS) - + end subroutine SurfParams_init - + endmodule SurfParams diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index e3f3f17ef..24a8e2b12 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -4,7 +4,7 @@ program Scale_Catch use MAPL use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT - USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, POROS_THRESHOLD_PEATCLSM + USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, PEATCLSM_POROS_THRESHOLD implicit none character(256) :: fname1, fname2, fname3 @@ -396,7 +396,7 @@ end subroutine calc_soil_moist ! PEAT CLSM - ensure low CATDEF on peat tiles ! ------------------------------------------- - where (catch(sca)%poros >= POROS_THRESHOLD_PEATCLSM) + where (catch(sca)%poros >= PEATCLSM_POROS_THRESHOLD) catch(sca)%catdef = 100. catch(sca)%rzexc = 0. catch(sca)%srfexc = 0. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index 15d1ce62a..bc8a2c27b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -3,7 +3,7 @@ program Scale_CatchCN use MAPL use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT - USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, POROS_THRESHOLD_PEATCLSM + USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, PEATCLSM_POROS_THRESHOLD implicit none character(256) :: fname1, fname2, fname3 @@ -427,7 +427,7 @@ end subroutine calc_soil_moist ! PEAT CLSM - ensure low CATDEF on peat tiles ! ------------------------------------------- - where (catch(sca)%poros >= POROS_THRESHOLD_PEATCLSM) + where (catch(sca)%poros >= PEATCLSM_POROS_THRESHOLD) catch(sca)%catdef = 100. catch(sca)%rzexc = 0. catch(sca)%srfexc = 0. From b3878281e1d5df3428c9d9c73643cf1edcddca1d Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 26 Jan 2022 22:21:13 -0500 Subject: [PATCH 44/66] fixing typo in previous commit (PEATCLSM poros threshold) --- .../GEOSland_GridComp/Shared/catch_constants.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 index 37aa1ca57..ad7184042 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 @@ -90,7 +90,7 @@ module catch_constants ! ! - reichle, 26 Jan 2022 - REAL, PARAMETER, PUBLIC :: PEATCLSM_THRESHOLD_POROS = 0.90 ! [m3/m3] + REAL, PARAMETER, PUBLIC :: PEATCLSM_POROS_THRESHOLD = 0.90 ! [m3/m3] ! max zbar for specific yield calc in PEATCLSM From 4d1c77ed1a5a682b8aa31c738224f87626693ed5 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 27 Jan 2022 19:07:38 -0500 Subject: [PATCH 45/66] added constants for PEATCLSM's piecewise linear relation between surface runoff and AR1 --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index b1ddfe274..f2286df81 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -289,6 +289,11 @@ SUBROUTINE SRUNOFF ( & REAL deficit,srun0,frun,qin, qinfil_l, qinfil_c, qcapac, excess_infil, & srunc, srunl, ptotal, excess, totcapac, watadd + ! constants for piecewise linear relationship between surface runoff and AR1 + + REAL, PARAMETER :: SRUN_AR1_MIN = 0.5 + REAL, PARAMETER :: SRUN_AR1_INVSLOPE = 0.1 + !**** - - - - - - - - - - - - - - - - - - - - - - - - - DO N=1,NCH @@ -331,7 +336,7 @@ SUBROUTINE SRUNOFF ( & ! handling numerical instability due to exceptional snow melt events at some pixels ! avoid AR1 to increase much higher than > 0.5 by enabling runoff !Added ramping to avoid potential oscillations (rdk, 09/18/20) - IF (AR1(N)>0.50) srun0=PTOTAL*amin1(1.,(ar1(n)-0.5)/0.1) + IF (AR1(N)>SRUN_AR1_MIN) srun0=PTOTAL*amin1(1.,(ar1(n)-SRUN_AR1_MIN)/SRUN_AR1_INVSLOPE) ! MB: even no surface runoff when srfmx is exceeded (activating macro-pore flow) ! Rewrote code to determine excess over capacity all at once (rdk, 09/18/20) @@ -421,10 +426,10 @@ SUBROUTINE SRUNOFF ( & srunc = 0. ! handling numerical instability due to exceptional snow melt events at some pixels ! avoid AR1 to increase much higher than > 0.5 by enabling runoff - IF (AR1(N)>0.50) THEN + IF (AR1(N)>SRUN_AR1_MIN) THEN !Added ramping to avoid potential oscillations (rdk, 09/18/20) - srunl = THRUL(n)*amin1(1.,(ar1(n)-0.5)/0.1) - srunc = THRUC(n)*amin1(1.,(ar1(n)-0.5)/0.1) + srunl = THRUL(n)*amin1(1.,(ar1(n)-SRUN_AR1_MIN)/SRUN_AR1_INVSLOPE) + srunc = THRUC(n)*amin1(1.,(ar1(n)-SRUN_AR1_MIN)/SRUN_AR1_INVSLOPE) ENDIF PTOTAL = THRUL(N) + THRUC(N) SRUN0 = srunl + srunc From a076928fda2fa92d72e6e2c6bb856c0fa9fdd9fb Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 27 Jan 2022 19:09:16 -0500 Subject: [PATCH 46/66] fixed comment in previous commit --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index f2286df81..1b6c27c9d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -289,7 +289,7 @@ SUBROUTINE SRUNOFF ( & REAL deficit,srun0,frun,qin, qinfil_l, qinfil_c, qcapac, excess_infil, & srunc, srunl, ptotal, excess, totcapac, watadd - ! constants for piecewise linear relationship between surface runoff and AR1 + ! constants for PEATCLSM piecewise linear relationship between surface runoff and AR1 REAL, PARAMETER :: SRUN_AR1_MIN = 0.5 REAL, PARAMETER :: SRUN_AR1_INVSLOPE = 0.1 From 7741de0ca63aec17487730dbe635fdaeb00edd9c Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 28 Jan 2022 18:14:15 -0500 Subject: [PATCH 47/66] overhauled Scale_Catch.F90 and Scale_CatchCN.F90: - removed outdated and redundant subroutines calc_soil_moist(), rzequil(), partition() - fixed (hopefully) major bug in Scale_CatchCN.F90 (missing veg1 input to catch_calc_soil_moist()) --- .../Utils/mk_restarts/Scale_Catch.F90 | 624 ++--------------- .../Utils/mk_restarts/Scale_CatchCN.F90 | 649 ++---------------- 2 files changed, 99 insertions(+), 1174 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index 24a8e2b12..bd5a1b238 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -2,9 +2,19 @@ #include "MAPL_Generic.h" program Scale_Catch + use MAPL - use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT - USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, PEATCLSM_POROS_THRESHOLD + + use LSM_ROUTINES, ONLY: & + catch_calc_soil_moist, & + catch_calc_tp, & + catch_calc_ght, & + DZGT + + USE CATCH_CONSTANTS, ONLY: & + N_GT => CATCH_N_GT, & + PEATCLSM_POROS_THRESHOLD + implicit none character(256) :: fname1, fname2, fname3 @@ -82,45 +92,10 @@ program Scale_Catch type(catch_rst) catch(3) - interface - subroutine calc_soil_moist( & - ncat,vegcls,dzsf,vgwmax,cdcr1,cdcr2,wpwet,poros, & - psis,bee,ars1,ars2,ars3,ara1,ara2, & - ara3,ara4,arw1,arw2,arw3,arw4, & - srfexc,rzexc,catdef, & - sfmc, rzmc, prmc, & - werror, sfmcun, rzmcun, prmcun ) - - implicit none - - integer, parameter :: KSNGL=4 - integer, intent(in) :: ncat - integer, dimension(ncat), intent(in) :: vegcls - - real(KIND=KSNGL), dimension(ncat), intent(in) :: dzsf,vgwmax,cdcr1,cdcr2 - real(KIND=KSNGL), dimension(ncat), intent(in) :: wpwet,poros,psis - real(KIND=KSNGL), dimension(ncat), intent(in) :: bee,ars1 - real(KIND=KSNGL), dimension(ncat), intent(in) :: ars2,ars3,ara1,ara2,ara3 - real(KIND=KSNGL), dimension(ncat), intent(in) :: ara4,arw1,arw2,arw3,arw4 - - real(KIND=KSNGL), dimension(ncat), intent(inout) :: srfexc, rzexc, catdef - - real(KIND=KSNGL), dimension(ncat), intent(out) :: sfmc, rzmc, prmc - - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: werror - - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: sfmcun - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: rzmcun - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: prmcun - end subroutine calc_soil_moist - end interface - - real, allocatable, dimension(:) :: sfmc, rzmc, prmc, werror, sfmcun, rzmcun, prmcun, dzsf - integer, allocatable, dimension(:) :: vegcls - real, allocatable, dimension(:) :: vegdyn + real, allocatable, dimension(:) :: dzsf, ar1, ar2, ar4 + integer, allocatable, dimension(:) :: vegcls real, allocatable, dimension(:,:) :: TP_IN, GHT_IN, FICE, GHT_OUT, TP_OUT - real, allocatable, dimension(:) :: swe_in,depth_in,areasc_in,areasc_out, depth_out - + real, allocatable, dimension(:) :: swe_in, depth_in, areasc_in, areasc_out, depth_out type(Netcdf4_fileformatter) :: formatter(3) type(Filemetadata) :: cfg(3) @@ -266,27 +241,25 @@ end subroutine calc_soil_moist catch(sca)%catdef = catch(old)%catdef * (catch(new)%cdcr1 / catch(old)%cdcr1) end where -! Sanity Check +! Sanity Check (catch_calc_soil_moist() forces consistency betw. srfexc, rzexc, catdef) ! ------------ print *, 'Performing Sanity Check ...' allocate ( dzsf(ntiles) ) - allocate ( sfmc(ntiles) ) - allocate ( rzmc(ntiles) ) - allocate ( prmc(ntiles) ) - allocate ( werror(ntiles) ) - allocate ( sfmcun(ntiles) ) - allocate ( rzmcun(ntiles) ) - allocate ( prmcun(ntiles) ) + allocate ( ar1( ntiles) ) + allocate ( ar2( ntiles) ) + allocate ( ar4( ntiles) ) dzsf = SURFLAY - call calc_soil_moist( ntiles,vegcls,dzsf, & - catch(sca)%vgwmax,catch(sca)%cdcr1,catch(sca)%cdcr2,catch(sca)%wpwet,catch(sca)%poros, & - catch(sca)%psis,catch(sca)%bee,catch(sca)%ars1,catch(sca)%ars2,catch(sca)%ars3,catch(sca)%ara1,catch(sca)%ara2, & - catch(sca)%ara3,catch(sca)%ara4,catch(sca)%arw1,catch(sca)%arw2,catch(sca)%arw3,catch(sca)%arw4, & - catch(sca)%srfexc,catch(sca)%rzexc,catch(sca)%catdef, & - sfmc, rzmc, prmc, werror, sfmcun, rzmcun, prmcun ) - + call catch_calc_soil_moist( ntiles, vegcls, dzsf, & + catch(sca)%vgwmax, catch(sca)%cdcr1, catch(sca)%cdcr2, & + catch(sca)%psis, catch(sca)%bee, catch(sca)%poros, catch(sca)%wpwet, & + catch(sca)%ars1, catch(sca)%ars2, catch(sca)%ars3, & + catch(sca)%ara1, catch(sca)%ara2, catch(sca)%ara3, catch(sca)%ara4, & + catch(sca)%arw1, catch(sca)%arw2, catch(sca)%arw3, catch(sca)%arw4, & + catch(sca)%srfexc, catch(sca)%rzexc, catch(sca)%catdef, & + ar1, ar2, ar4 ) + n = count( catch(sca)%catdef .ne. catch(new)%catdef ) write(6,300) n,100*n/ntiles n = count( catch(sca)%srfexc .ne. catch(new)%srfexc ) @@ -422,9 +395,12 @@ end subroutine calc_soil_moist stop contains - subroutine allocatch (ntiles,catch) - integer ntiles - type(catch_rst) catch + + subroutine allocatch (ntiles,catch) + + integer ntiles + + type(catch_rst) catch allocate( catch% bf1(ntiles) ) allocate( catch% bf2(ntiles) ) @@ -488,11 +464,11 @@ subroutine allocatch (ntiles,catch) end subroutine allocatch subroutine readcatch_nc4 (catch,formatter, rc) - type(catch_rst) catch - type(Netcdf4_fileformatter) :: formatter - integer, optional, intent(out) :: rc - integer :: status - character(256) :: Iam = "readcatch_nc4" + type(catch_rst) catch + type(Netcdf4_fileformatter) :: formatter + integer, optional, intent(out) :: rc + integer :: status + character(256) :: Iam = "readcatch_nc4" call MAPL_VarRead(formatter,"BF1",catch%bf1, __RC__) call MAPL_VarRead(formatter,"BF2",catch%bf2, __RC__) @@ -753,525 +729,3 @@ subroutine writecatch (unit,catch) end subroutine writecatch end program - - subroutine calc_soil_moist( & - ncat,vegcls,dzsf,vgwmax,cdcr1,cdcr2,wpwet,poros, & - psis,bee,ars1,ars2,ars3,ara1,ara2, & - ara3,ara4,arw1,arw2,arw3,arw4, & - srfexc,rzexc,catdef, & - sfmc, rzmc, prmc, & - werror, sfmcun, rzmcun, prmcun ) - - ! Calculate diagnostic soil moisture content from prognostic - ! excess/deficit variables. - ! - ! On input, also check validity of prognostic excess/deficit variables - ! and modify if necessary. Perturbed or updated excess/deficit variables - ! in data assimilation integrations may be unphysical. - ! Optional output "werror" contains excess or missing water related - ! to inconsistency. - ! - ! Optional outputs "smfcun", "rzmcun", "prmcun" are surface, - ! root zone, and profile moisture content for unsaturated areas only, - ! ie. excluding the saturated area of the catchment. - ! - ! NOTE: When calling with optional output arguments, use keywords - ! unless arguments are in proper order! - ! - ! Example: - ! (don't want "werror" as output, but want "*mcun" output) - ! - ! call calc_soil_moist( & - ! ncat, ... & - ! sfmc, rzmc, prmc, & - ! sfmcun=sfmc_unsat, & - ! rzmcun=rzmc_unsat, & - ! prmcun=prmc_unsat ) - ! - ! replaces moisture_sep_22_2003.f (and older moisture.f) - ! - ! koster+reichle, Feb 5, 2004 - ! - ! revised - koster+reichle, Mar 19, 2004 - ! - ! added optional *un output - koster+reichle, Apr 6, 2004 - ! - ! ---------------------------------------------------------------- - - - implicit none - - integer, parameter :: KSNGL=4 - integer, intent(in) :: ncat - integer, dimension(ncat), intent(in) :: vegcls - - real(KIND=KSNGL), dimension(ncat), intent(in) :: dzsf,vgwmax,cdcr1,cdcr2 - real(KIND=KSNGL), dimension(ncat), intent(in) :: wpwet,poros,psis - real(KIND=KSNGL), dimension(ncat), intent(in) :: bee,ars1 - real(KIND=KSNGL), dimension(ncat), intent(in) :: ars2,ars3,ara1,ara2,ara3 - real(KIND=KSNGL), dimension(ncat), intent(in) :: ara4,arw1,arw2,arw3,arw4 - - real(KIND=KSNGL), dimension(ncat), intent(inout) :: srfexc, rzexc, catdef - - real(KIND=KSNGL), dimension(ncat), intent(out) :: sfmc, rzmc, prmc - - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: werror - - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: sfmcun - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: rzmcun - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: prmcun - - ! ---------------------------- - ! - ! local variables - - integer :: n - - real(KIND=KSNGL), parameter :: dtstep_dummy = -9999. - - real(KIND=KSNGL), dimension(ncat) :: rzeq, runsrf_dummy, catdef_dummy - real(KIND=KSNGL), dimension(ncat) :: ar1, ar2, ar4, prmc_orig - real(KIND=KSNGL), dimension(ncat) :: srfmn, srfmx, swsrf1, swsrf2, swsrf4, rzi - - - ! -------------------------------------------------------------------- - ! - ! compute soil water storage upon input [mm] - - do n=1,ncat - prmc_orig(n) = & - (cdcr2(n)/(1.-wpwet(n))-catdef(n)+rzexc(n)+srfexc(n)) - enddo - - ! ----------------------------------- - ! - ! check limits of catchment deficit - ! - ! increased minimum catchment deficit from 0.01 to 1. to make the - ! check work with perturbed parameters and initial condition - ! reichle, 16 May 01 - ! - ! IT REALLY SHOULD WORK WITH catdef > 0 (rather than >1.) ???? - ! reichle, 5 Feb 2004 - - do n=1,ncat - catdef(n)=max(1.,min(cdcr2(n),catdef(n))) - end do - - ! ------------------------------------------------------------------ - ! - ! check limits of root zone excess - ! - ! calculate root zone equilibrium moisture for given catchment deficit - - call rzequil( & - ncat, vegcls, catdef, vgwmax, & - cdcr1, cdcr2, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, & - arw1, arw2, arw3, arw4, & - rzeq) - - ! assume srfexc=0 and constrain rzexc appropriately - ! (iteration would be needed to contrain srfexc and rzexc simultaneously) - - do n=1,ncat - rzexc(n)=max(wpwet(n)*vgwmax(n)-rzeq(n),min(vgwmax(n)-rzeq(n),rzexc(n))) - end do - - ! this translates into: - ! - ! wilting level < rzmc < porosity - ! - ! or more precisely: wpwet*vgwmax < rzeq+rzexc < vgwmax - ! - ! NOTE: root zone moisture is not allowed to drop below wilting level - - ! ----------------------------------------------------------------- - ! - ! Call partition() for computation of surface moisture content. - ! - ! Call to partition() also checks limits of surface excess. - ! - ! Call partition with dtstep_dummy: - ! In partition, dtstep is only used for a correction that - ! puts water into runsrf (for which runsrf_dummy is used here). - ! Also use catdef_dummy because partition() updates catdef - ! whenever srfexc exceeds physical bounds, but this is not desired here. - - runsrf_dummy = 0. - catdef_dummy = catdef - - call partition( & - ncat,dtstep_dummy,vegcls,dzsf,rzexc, & - rzeq,vgwmax,cdcr1,cdcr2, & - psis,bee,poros,wpwet, & - ars1,ars2,ars3, & - ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4,.false., & - srfexc,catdef_dummy,runsrf_dummy, & - ar1, ar2, ar4,srfmx,srfmn, & - swsrf1,swsrf2,swsrf4,rzi & - ) - - ! compute surface, root zone, and profile soil moisture - - do n=1,ncat - - sfmc(n) = poros(n) * & - (swsrf1(n)*ar1(n) + swsrf2(n)*ar2(n) + swsrf4(n)*ar4(n)) - - rzmc(n) = (rzeq(n)+rzexc(n)+srfexc(n))*poros(n)/vgwmax(n) - - ! compute revised soil water storage [mm] - - prmc(n) = & - (cdcr2(n)/(1.-wpwet(n))-catdef(n)+rzexc(n)+srfexc(n)) - - ! compute error in soil water storage [mm] (if argument is present) - - if (present(werror)) werror(n)=(prmc(n)-prmc_orig(n)) - - ! convert to volumetric soil moisture - ! note: dzpr = (cdcr2/(1-wpwet)) / poros - - prmc(n) = prmc(n)*poros(n) / (cdcr2(n)/(1.-wpwet(n))) - - - ! check for negative soil moisture - - if ( (sfmc(n)<.0) .or. (rzmc(n)<.0) .or. (prmc(n)<.0) ) then - - write (*,*) 'FOUND NEGATIVE SOIL MOISTURE CONTENT.... stopping' - write (*,*) n, sfmc(n), rzmc(n), prmc(n) - stop - end if - - ! compute moisture content in unsaturated areas [m3/m3] (if arg present) - - if (ar1(n)<1.) then - - if (present(prmcun)) prmcun(n)=(prmc(n)-poros(n)*ar1(n))/(1.-ar1(n)) - if (present(rzmcun)) rzmcun(n)=(rzmc(n)-poros(n)*ar1(n))/(1.-ar1(n)) - if (present(sfmcun)) sfmcun(n)=(sfmc(n)-poros(n)*ar1(n))/(1.-ar1(n)) - - else - - if (present(prmcun)) prmcun(n)=poros(n) - if (present(rzmcun)) rzmcun(n)=poros(n) - if (present(sfmcun)) sfmcun(n)=poros(n) - - end if - - enddo - - return - - end subroutine calc_soil_moist - - SUBROUTINE PARTITION ( & - NCH,DTSTEP,ITYP,DZSF,RZEXC,RZEQ,VGWMAX,CDCR1,CDCR2,& - PSIS,BEE,poros,WPWET, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4,BUG, & - srfexc,catdef,runsrf, & - AR1, AR2, AR4, srfmx, srfmn, & - SWSRF1,SWSRF2,SWSRF4,RZI & - ) - - IMPLICIT NONE - -! ------------------------------------------------------------------- - INTEGER, INTENT(IN) :: NCH - INTEGER, INTENT(IN), DIMENSION(NCH) :: ITYP - - REAL, INTENT(IN) :: DTSTEP - REAL, INTENT(IN), DIMENSION(NCH) :: DZSF,RZEXC,RZEQ,VGWMAX,CDCR1,CDCR2, & - PSIS,BEE,poros,WPWET, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4 - - LOGICAL, INTENT(IN) :: BUG -! ------------------------------------------------------------------- - REAL, INTENT(INOUT), DIMENSION(NCH) :: srfexc,catdef,runsrf -! ------------------------------------------------------------------- - REAL, INTENT(OUT), DIMENSION(NCH) :: AR1, AR2, AR4, srfmx, srfmn, & - SWSRF1, SWSRF2, SWSRF4, RZI -! ------------------------------------------------------------------- - INTEGER :: N - - REAL :: cor, A150, W150, WMIN, AX, WMNEW, WRZ, TERM1, TERM2, TERM3, & - AREA0, AREA1, AREA2, AREA3, AREA4, ASCALE, WILT, D1, D2, CDI, & - DELTA1, DELTA2, DELTA4, MULTAR, CATDEFX, RZEQX, RZEQW, FACTOR, & - X0, RZEQY, CATDEFW, AR1W, ASUM, RZEQYI, RZEQWI, RZEQXI, AR20, & - ARG1, EXPARG1, ARG2, EXPARG2, ARG3, EXPARG3 !, surflay - - LOGICAL :: LSTRESS - - - DATA LSTRESS/.FALSE./ !,surflay/20./ - -!**** -!**** -------------------------------------------------- - -!rr next line for debugging, sep 23, 2003, reichle -!rr -!rr write (*,*) 'entering partition()' - - DO N=1,NCH - - WILT=WPWET(N) - WRZ=RZEXC(N)/VGWMAX(N) - CATDEFX=AMIN1( CATDEF(N) , CDCR1(N) ) - -! CDI DEFINES IF THE SHAPE PARAMETER IS ADJUSTED IN ONE OR TWO SEGMENTS - if (ara1(n) .ne. ara3(n)) then - cdi=(ara4(n)-ara2(n))/(ara1(n)-ara3(n)) - else - cdi=0. - endif - - AR1(N)= AMIN1(1.,AMAX1(0.,(1.+ars1(n)*CATDEFX) & - /(1.+ars2(n)*CATDEFX+ars3(n)*CATDEFX*CATDEFX))) - - if (CATDEFX .ge. cdi) then - ax=ara3(n)*CATDEFX+ara4(n) - else - ax=ara1(n)*CATDEFX+ara2(n) - endif - - WMIN=AMIN1(1.,AMAX1(0.,arw4(n)+(1.-arw4(n))* & - (1.+arw1(n)*CATDEFX) & - /(1.+arw2(n)*CATDEFX+arw3(n)*CATDEFX*CATDEFX))) - -!**** CRITICAL VALUE 1: AVERAGE MOISTURE IN ROOT ZONE AT WMIN -!**** ASSOCIATED WITH CATDEF. - ARG1=AMAX1(-40., AMIN1(40., -AX*(1.-WMIN))) - EXPARG1=EXP(ARG1) - RZEQX=(WMIN-1.-(2./AX))*EXPARG1 + WMIN + (2./AX) - RZEQXI=AX*EXPARG1 * & - ( -1. -(2./AX) - (2./(AX*AX)) + WMIN + (WMIN/AX) ) & - + WMIN + 2./AX - AR20=1.+(-AX-1.+AX*WMIN)*EXPARG1 - RZEQXI=RZEQXI/(AR20+1.E-20) - -!**** CRITICAL VALUE 2: AVERAGE MOISTURE IN ROOT ZONE WHEN WMIN -!**** IS EXACTLY AT WILTING POINT. - ARG2=AMAX1(-40., AMIN1(40., -AX*(1.-WILT))) - EXPARG2=EXP(ARG2) - RZEQW=(WILT-1.-(2./AX))*EXPARG2 + WILT + (2./AX) - RZEQWI=AX*EXPARG2 * & - ( -1. -(2./AX) - (2./(AX*AX)) + WILT + (WILT/AX) ) & - + WILT + 2./AX - AR20=1.+(-AX-1.+AX*WILT)*EXPARG2 - RZEQWI=RZEQWI/(AR20+1.E-20) - -!**** SITUATION 1: CATDEF LE CDCR1 - IF(CATDEF(N) .LE. CDCR1(N)) THEN - RZEQY=RZEQX+WRZ - RZEQYI=RZEQXI+WRZ - WMNEW=WMIN+WRZ - ARG3=AMAX1(-40., AMIN1(40., -AX*(1.-WMNEW))) - EXPARG3=EXP(ARG3) - AREA1=(1.+AX-AX*WMIN)*EXPARG1 - AREA2=(1.+AX-AX*WMNEW)*EXPARG3 - IF(WMNEW .GE. WILT) THEN - AR1(N)=AR1(N)+AREA2-AREA1 - AR2(N)=1.-AR1(N) - AR4(N)=0. - ENDIF - IF(WMNEW .LT. WILT) THEN - AREA3=(1.+AX-AX*WILT)*EXPARG2 - AR1(N)=AR1(N)+AREA3-AREA1 - AR2(N)=1.-AR1(N) - FACTOR=(RZEQX+WRZ-WILT)/(RZEQW-WILT) - AR1(N)=AR1(N)*FACTOR - AR2(N)=AR2(N)*FACTOR - AR4(N)=1.-FACTOR - ENDIF - ENDIF - -!**** SITUATION 2: CATDEF GT CDCR1 - IF(CATDEF(N) .GT. CDCR1(N)) THEN - FACTOR=(CDCR2(N)-CATDEF(N))/(CDCR2(N)-CDCR1(N)) - RZEQY=WILT+(RZEQX-WILT)*FACTOR+WRZ - RZEQYI=WILT+(RZEQXI-WILT)*FACTOR+WRZ - - IF(RZEQY .LT. WILT) THEN - IF(RZEQY .LT. WILT-.001) THEN -!rr WRITE(*,*) 'RZEXC WAY TOO LOW! N=',N,' RZEQY=',RZEQY -!rr WRITE(*,*) 'SRFEXC=',SRFEXC(N),'RZEXC=',RZEXC(N), -!rr & 'CATDEF=',CATDEF(N) -! ELSE -! WRITE(*,*) 'RZEXC TOO LOW N=',N - ENDIF - RZEQY=WILT - RZEQYI=WILT - ENDIF - - IF(RZEQY .GE. RZEQX) THEN ! RZEXC BRINGS MOISTURE ABOVE CDCR1 POINT - WMNEW=WMIN+(RZEQY-RZEQX) - ARG3=AMAX1(-40., AMIN1(40., -AX*(1.-WMNEW))) - EXPARG3=EXP(ARG3) - AREA1=(1.+AX-AX*WMIN)*EXPARG1 - AREA2=(1.+AX-AX*WMNEW)*EXPARG3 - AR1(N)=AR1(N)+(AREA2-AREA1) - AR2(N)=1.-AR1(N) - AR4(N)=0. - ENDIF - - IF(RZEQY .LT. RZEQX .AND. RZEQY .GE. RZEQW) THEN - CATDEFW=CDCR2(N)+((RZEQW-WILT)/(RZEQX-WILT))*(CDCR1(N)-CDCR2(N)) - AR1W= AMIN1(1.,AMAX1(0.,(1.+ars1(n)*CATDEFW) & - /(1.+ars2(n)*CATDEFW+ars3(n)*CATDEFW*CATDEFW))) - FACTOR=(RZEQY-RZEQW)/(RZEQX-RZEQW) - AR1(N)=AR1W+FACTOR*(AR1(N)-AR1W) - AR2(N)=1.-AR1(N) - AR4(N)=0. - ENDIF - - IF(RZEQY .LT. RZEQW) THEN - CATDEFW=CDCR2(N)+((RZEQW-WILT)/(RZEQX-WILT))*(CDCR1(N)-CDCR2(N)) - AR1W= AMIN1(1.,AMAX1(0.,(1.+ars1(n)*CATDEFW) & - /(1.+ars2(n)*CATDEFW+ars3(n)*CATDEFW*CATDEFW))) - AR1(N)=AR1W - AR2(N)=1.-AR1(N) - FACTOR=(RZEQY-WILT)/(RZEQW-WILT) - AR1(N)=AR1(N)*FACTOR - AR2(N)=AR2(N)*FACTOR - AR4(N)=1.-FACTOR - ENDIF - - ENDIF - - RZI(N)=RZEQYI - - SWSRF1(N)=1. -!mjs: changed .001 temporarily because of large bee. - SWSRF2(N)=AMIN1(1., AMAX1(0.01, RZEQYI)) - SWSRF4(N)=AMIN1(1., AMAX1(0.01, WILT)) - -!**** EXTRAPOLATION OF THE SURFACE WETNESSES - -! 1st step: surface wetness in the unstressed fraction without considering -! the surface excess; we just assume an equilibrium profile from -! the middle of the root zone to the surface. - - SWSRF2(N)=((SWSRF2(N)**(-BEE(N))) - (.5/PSIS(N)))**(-1./BEE(N)) - SWSRF4(N)=((SWSRF4(N)**(-BEE(N))) - (.5/PSIS(N)))**(-1./BEE(N)) - -! srfmx is the maximum amount of water that can be added to the surface layer -! The choice of defining SWSRF4 like SWSRF2 needs to be better examined. - srfmx(n)=ar2(n)*(1.-swsrf2(n))*(dzsf(n)*poros(n)) - srfmx(n)=srfmx(n)+ar4(n)*(1.-swsrf4(n))*(dzsf(n)*poros(n)) -!**** For calculation of srfmn, assume surface moisture associated with -!**** AR1 is constantly replenished by water table. - srfmn(n)=-(ar2(n)*swsrf2(n)+ar4(n)*swsrf4(n))*(dzsf(n)*poros(n)) - - if(srfexc(n).gt.srfmx(n)) then - cor=srfexc(n)-srfmx(n) ! The correction is here - srfexc(n)=srfmx(n) - catdef(n)=catdef(n)-cor - if(catdef(n).lt.0.) then - runsrf(n)=runsrf(n)-catdef(n)/dtstep - catdef(n)=0. - endif - else if(srfexc(n).lt.srfmn(n)) then - cor=srfexc(n)-srfmn(n) - catdef(n)=catdef(n)-cor - srfexc(n)=srfmn(n) - else - cor=0. - endif - - SWSRF2(N)=SWSRF2(N)+SRFEXC(N)/(dzsf(n)*poros(n)*(1.-ar1(n))+1.e-20) - SWSRF2(N)=AMIN1(1., AMAX1(1.E-5, SWSRF2(N))) - swsrf4(n)=swsrf4(n)+srfexc(n)/(dzsf(n)*poros(n)*(1.-ar1(n))+1.e-20) - SWSRF4(N)=AMIN1(1., AMAX1(1.E-5, SWSRF4(N))) - - IF (AR1(N) .ge. 1.-1.E-5) then - AR1(N)=1. - AR2(N)=0. - AR4(N)=0. - SWSRF2(N)=1. - SWSRF4(N)=wilt - ENDIF - - IF (AR1(N) .LT. 0.) then -!rr IF(AR1(N) .LT. -1.E-3) WRITE(*,*) 'AR1 TOO LOW: AR1=',AR1(N) - AR1(N)=0. - ENDIF - ar1(n)=amax1(0., amin1(1., ar1(n))) - ar2(n)=amax1(0., amin1(1., ar2(n))) - ar4(n)=amax1(0., amin1(1., ar4(n))) - asum=ar1(n)+ar2(n)+ar4(n) - if(asum .lt. .9999 .or. asum .gt. 1.0001) then - write(*,*) 'Areas do not add to 1: sum=',asum,'N=',n - endif - - - ENDDO - - - RETURN - END SUBROUTINE PARTITION - - SUBROUTINE RZEQUIL ( & - NCH,ITYP,CATDEF,VGWMAX,CDCR1,CDCR2,WPWET, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4, & - RZEQ & - ) - - IMPLICIT NONE - - INTEGER, INTENT(IN) :: NCH - INTEGER, INTENT(IN), DIMENSION(NCH) :: ITYP - REAL, INTENT(IN), DIMENSION(NCH) :: CATDEF, VGWMAX, CDCR1, CDCR2, & - WPWET, ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, & - arw2, arw3, arw4 - - REAL, INTENT(OUT), DIMENSION(NCH) :: RZEQ - - INTEGER N - REAL AX,WMIN,ASCALE,cdi,wilt,catdefx,factor,ARG1,EXPARG1 - -! ---------------------------------------------------------------------- - - DO N=1,NCH - - WILT=WPWET(N) - CATDEFX=AMIN1( CATDEF(N) , CDCR1(N) ) - -! CDI DEFINES IF THE SHAPE PARAMETER IS ADJUSTED IN ONE OR TWO SEGMENTS - if (ara1(n) .ne. ara3(n)) then - cdi=(ara4(n)-ara2(n))/(ara1(n)-ara3(n)) - else - cdi=0. - endif - - if (CATDEFX .ge. cdi) then - ax=ara3(n)*CATDEFX+ara4(n) - else - ax=ara1(n)*CATDEFX+ara2(n) - endif - - WMIN=AMIN1(1.,AMAX1(0.,arw4(n)+(1.-arw4(n))*(1.+arw1(n)*CATDEFX) & - /(1.+arw2(n)*CATDEFX+arw3(n)*CATDEFX*CATDEFX))) - - ARG1=AMAX1(-40., AMIN1(40., -AX*(1.-WMIN))) - EXPARG1=EXP(ARG1) - RZEQ(N)=(WMIN-1.-(2./AX))*EXPARG1 + WMIN + (2./AX) - - IF(CATDEF(N) .GT. CDCR1(N)) THEN - FACTOR=(CDCR2(N)-CATDEF(N))/(CDCR2(N)-CDCR1(N)) - RZEQ(N)=WILT+(RZEQ(N)-WILT)*FACTOR - ENDIF - -! scaling: - RZEQ(N)=AMIN1(1.,AMAX1(0.,RZEQ(N))) - RZEQ(N)=RZEQ(N)*VGWMAX(N) - - ENDDO - - RETURN - END SUBROUTINE RZEQUIL diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index bc8a2c27b..25fc9368c 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -1,9 +1,23 @@ #define I_AM_MAIN #include "MAPL_Generic.h" + program Scale_CatchCN + use MAPL - use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT - USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT, PEATCLSM_POROS_THRESHOLD + + use LSM_ROUTINES, ONLY: & + catch_calc_soil_moist, & + catch_calc_tp, & + catch_calc_ght, & + DZGT + + USE CATCH_CONSTANTS, ONLY: & + N_GT => CATCH_N_GT, & + PEATCLSM_POROS_THRESHOLD + + USE CLM_VARPAR, ONLY: & + MAP_CAT + implicit none character(256) :: fname1, fname2, fname3 @@ -16,9 +30,10 @@ program Scale_CatchCN integer :: iargc real :: SURFLAY ! (Ganymed-3 and earlier) SURFLAY=20.0 for Old Soil Params ! (Ganymed-4 and later ) SURFLAY=50.0 for New Soil Params + real :: WEMIN_IN, WEMIN_OUT character*256 :: arg(6) - integer, parameter :: nveg = 4 + integer, parameter :: nveg = 4 integer, parameter :: nzone = 3 integer :: VAR_COL, VAR_PFT integer, parameter :: VAR_COL_CLM40 = 40 ! number of CN column restart variables @@ -27,7 +42,6 @@ program Scale_CatchCN integer, parameter :: VAR_COL_CLM45 = 35 ! number of CN column restart variables integer, parameter :: VAR_PFT_CLM45 = 75 ! number of CN PFT variables per column - real :: WEMIN_IN, WEMIN_OUT logical :: clm45 = .false. integer :: un_dim3 @@ -109,48 +123,17 @@ program Scale_CatchCN type(catch_rst) catch(3) - interface - subroutine calc_soil_moist( & - ncat,dzsf,vgwmax,cdcr1,cdcr2,wpwet,poros, & - psis,bee,ars1,ars2,ars3,ara1,ara2, & - ara3,ara4,arw1,arw2,arw3,arw4, & - srfexc,rzexc,catdef, & - sfmc, rzmc, prmc, & - werror, sfmcun, rzmcun, prmcun ) - - implicit none - - integer, parameter :: KSNGL=4 - integer, intent(in) :: ncat - - real(KIND=KSNGL), dimension(ncat), intent(in) :: dzsf,vgwmax,cdcr1,cdcr2 - real(KIND=KSNGL), dimension(ncat), intent(in) :: wpwet,poros,psis - real(KIND=KSNGL), dimension(ncat), intent(in) :: bee,ars1 - real(KIND=KSNGL), dimension(ncat), intent(in) :: ars2,ars3,ara1,ara2,ara3 - real(KIND=KSNGL), dimension(ncat), intent(in) :: ara4,arw1,arw2,arw3,arw4 - - real(KIND=KSNGL), dimension(ncat), intent(inout) :: srfexc, rzexc, catdef - - real(KIND=KSNGL), dimension(ncat), intent(out) :: sfmc, rzmc, prmc - - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: werror - - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: sfmcun - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: rzmcun - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: prmcun - end subroutine calc_soil_moist - end interface - - real, allocatable, dimension(:) :: sfmc, rzmc, prmc, werror, sfmcun, rzmcun, prmcun, dzsf - real, allocatable, dimension(:) :: vegdyn + real, allocatable, dimension(:) :: dzsf, ar1, ar2, ar4 + integer, allocatable, dimension(:) :: veg1 real, allocatable, dimension(:,:) :: TP_IN, GHT_IN, FICE, GHT_OUT, TP_OUT - real, allocatable, dimension(:) :: swe_in,depth_in,areasc_in,areasc_out, depth_out + real, allocatable, dimension(:) :: swe_in, depth_in, areasc_in, areasc_out, depth_out type(Netcdf4_fileformatter) :: formatter(3) type(Filemetadata) :: cfg(3) integer :: i, rc, filetype integer :: status character(256) :: Iam = "Scale_CatchCN" + ! Usage ! ----- if (iargc() /= 6) then @@ -172,13 +155,13 @@ end subroutine calc_soil_moist ! ------------------------------- read(arg(3),'(a)') fname3 - call MAPL_NCIOGetFileType(fname1, filetype, rc=rc) + call MAPL_NCIOGetFileType(fname1, filetype, __RC__) if (filetype == 0) then - call formatter(1)%open(trim(fname1),pFIO_READ, rc=rc) - call formatter(2)%open(trim(fname2),pFIO_READ, rc=rc) - cfg(1)=formatter(1)%read(rc=rc) - cfg(2)=formatter(2)%read(rc=rc) + call formatter(1)%open(trim(fname1),pFIO_READ, __RC__) + call formatter(2)%open(trim(fname2),pFIO_READ, __RC__) + cfg(1)=formatter(1)%read(__RC__) + cfg(2)=formatter(2)%read(__RC__) ! else ! open(unit=10, file=trim(fname1), form='unformatted') ! open(unit=20, file=trim(fname2), form='unformatted') @@ -204,8 +187,8 @@ end subroutine calc_soil_moist if (filetype ==0) then - ntiles = cfg(1)%get_dimension('tile', rc=rc) - un_dim3 = cfg(1)%get_dimension('unknown_dim3', rc=rc) + ntiles = cfg(1)%get_dimension('tile', __RC__) + un_dim3 = cfg(1)%get_dimension('unknown_dim3', __RC__) if(un_dim3 == 105) then clm45 = .true. VAR_COL = VAR_COL_CLM45 @@ -248,9 +231,19 @@ end subroutine calc_soil_moist end if + allocate( veg1(ntiles) ) + + where(ITY(:,1) > 0.) + VEG1 = map_cat(nint(catch(new)%ITY(:,1))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + elsewhere + VEG1 = map_cat(nint(catch(new)%ITY(:,2))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 + endwhere + + ! Create Scaled Catch ! ------------------- sca = 3 + catch(sca) = catch(new) ! 1) soil moisture prognostics @@ -297,27 +290,25 @@ end subroutine calc_soil_moist catch(sca)%catdef = catch(old)%catdef * (catch(new)%cdcr1 / catch(old)%cdcr1) end where -! Sanity Check +! Sanity Check (catch_calc_soil_moist() forces consistency betw. srfexc, rzexc, catdef) ! ------------ print *, 'Performing Sanity Check ...' allocate ( dzsf(ntiles) ) - allocate ( sfmc(ntiles) ) - allocate ( rzmc(ntiles) ) - allocate ( prmc(ntiles) ) - allocate ( werror(ntiles) ) - allocate ( sfmcun(ntiles) ) - allocate ( rzmcun(ntiles) ) - allocate ( prmcun(ntiles) ) + allocate ( ar1( ntiles) ) + allocate ( ar2( ntiles) ) + allocate ( ar4( ntiles) ) dzsf = SURFLAY - call calc_soil_moist( ntiles,dzsf, & - catch(sca)%vgwmax,catch(sca)%cdcr1,catch(sca)%cdcr2,catch(sca)%wpwet,catch(sca)%poros, & - catch(sca)%psis,catch(sca)%bee,catch(sca)%ars1,catch(sca)%ars2,catch(sca)%ars3,catch(sca)%ara1,catch(sca)%ara2, & - catch(sca)%ara3,catch(sca)%ara4,catch(sca)%arw1,catch(sca)%arw2,catch(sca)%arw3,catch(sca)%arw4, & - catch(sca)%srfexc,catch(sca)%rzexc,catch(sca)%catdef, & - sfmc, rzmc, prmc, werror, sfmcun, rzmcun, prmcun ) - + call catch_calc_soil_moist( ntiles, veg1, dzsf, & + catch(sca)%vgwmax, catch(sca)%cdcr1, catch(sca)%cdcr2, & + catch(sca)%psis, catch(sca)%bee, catch(sca)%poros, catch(sca)%wpwet, & + catch(sca)%ars1, catch(sca)%ars2, catch(sca)%ars3, & + catch(sca)%ara1, catch(sca)%ara2, catch(sca)%ara3, catch(sca)%ara4, & + catch(sca)%arw1, catch(sca)%arw2, catch(sca)%arw3, catch(sca)%arw4, & + catch(sca)%srfexc, catch(sca)%rzexc, catch(sca)%catdef, & + ar1, ar2, ar4 ) + n = count( catch(sca)%catdef .ne. catch(new)%catdef ) write(6,300) n,100*n/ntiles n = count( catch(sca)%srfexc .ne. catch(new)%srfexc ) @@ -433,14 +424,12 @@ end subroutine calc_soil_moist catch(sca)%srfexc = 0. end where - ! Write Scaled Catch ! ------------------ - if (filetype ==0) then cfg(3)=cfg(2) - call formatter(3)%create(fname3, rc=rc) - call formatter(3)%write(cfg(3), rc=rc) + call formatter(3)%create(fname3, __RC__) + call formatter(3)%write(cfg(3), __RC__) call writecatchcn_nc4 ( catch(sca), formatter(3) ,cfg(3) ) ! else ! call writecatchcn ( 30,catch(sca) ) @@ -455,11 +444,12 @@ end subroutine calc_soil_moist stop contains - subroutine allocatch (ntiles,catch) - - integer ntiles - type(catch_rst) catch + subroutine allocatch (ntiles,catch) + + integer ntiles + + type(catch_rst) catch allocate( catch% bf1(ntiles) ) allocate( catch% bf2(ntiles) ) @@ -546,8 +536,8 @@ subroutine readcatchcn_nc4 (catch,formatter,cfg, rc) integer :: j, dim1,dim2 type(Variable), pointer :: myVariable character(len=:), pointer :: dname - character(256) :: Iam = "readcatchcn_nc4" integer :: status + character(256) :: Iam = "readcatchcn_nc4" call MAPL_VarRead(formatter,"BF1",catch%bf1, __RC__) call MAPL_VarRead(formatter,"BF2",catch%bf2, __RC__) @@ -983,522 +973,3 @@ end subroutine writecatchcn end program - subroutine calc_soil_moist( & - ncat,dzsf,vgwmax,cdcr1,cdcr2,wpwet,poros, & - psis,bee,ars1,ars2,ars3,ara1,ara2, & - ara3,ara4,arw1,arw2,arw3,arw4, & - srfexc,rzexc,catdef, & - sfmc, rzmc, prmc, & - werror, sfmcun, rzmcun, prmcun ) - - ! Calculate diagnostic soil moisture content from prognostic - ! excess/deficit variables. - ! - ! On input, also check validity of prognostic excess/deficit variables - ! and modify if necessary. Perturbed or updated excess/deficit variables - ! in data assimilation integrations may be unphysical. - ! Optional output "werror" contains excess or missing water related - ! to inconsistency. - ! - ! Optional outputs "smfcun", "rzmcun", "prmcun" are surface, - ! root zone, and profile moisture content for unsaturated areas only, - ! ie. excluding the saturated area of the catchment. - ! - ! NOTE: When calling with optional output arguments, use keywords - ! unless arguments are in proper order! - ! - ! Example: - ! (don't want "werror" as output, but want "*mcun" output) - ! - ! call calc_soil_moist( & - ! ncat, ... & - ! sfmc, rzmc, prmc, & - ! sfmcun=sfmc_unsat, & - ! rzmcun=rzmc_unsat, & - ! prmcun=prmc_unsat ) - ! - ! replaces moisture_sep_22_2003.f (and older moisture.f) - ! - ! koster+reichle, Feb 5, 2004 - ! - ! revised - koster+reichle, Mar 19, 2004 - ! - ! added optional *un output - koster+reichle, Apr 6, 2004 - ! - ! ---------------------------------------------------------------- - - - implicit none - - integer, parameter :: KSNGL=4 - integer, intent(in) :: ncat - - real(KIND=KSNGL), dimension(ncat), intent(in) :: dzsf,vgwmax,cdcr1,cdcr2 - real(KIND=KSNGL), dimension(ncat), intent(in) :: wpwet,poros,psis - real(KIND=KSNGL), dimension(ncat), intent(in) :: bee,ars1 - real(KIND=KSNGL), dimension(ncat), intent(in) :: ars2,ars3,ara1,ara2,ara3 - real(KIND=KSNGL), dimension(ncat), intent(in) :: ara4,arw1,arw2,arw3,arw4 - - real(KIND=KSNGL), dimension(ncat), intent(inout) :: srfexc, rzexc, catdef - - real(KIND=KSNGL), dimension(ncat), intent(out) :: sfmc, rzmc, prmc - - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: werror - - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: sfmcun - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: rzmcun - real(KIND=KSNGL), dimension(ncat), intent(out), optional :: prmcun - - ! ---------------------------- - ! - ! local variables - - integer :: n - - real(KIND=KSNGL), parameter :: dtstep_dummy = -9999. - - real(KIND=KSNGL), dimension(ncat) :: rzeq, runsrf_dummy, catdef_dummy - real(KIND=KSNGL), dimension(ncat) :: ar1, ar2, ar4, prmc_orig - real(KIND=KSNGL), dimension(ncat) :: srfmn, srfmx, swsrf1, swsrf2, swsrf4, rzi - - - ! -------------------------------------------------------------------- - ! - ! compute soil water storage upon input [mm] - - do n=1,ncat - prmc_orig(n) = & - (cdcr2(n)/(1.-wpwet(n))-catdef(n)+rzexc(n)+srfexc(n)) - enddo - - ! ----------------------------------- - ! - ! check limits of catchment deficit - ! - ! increased minimum catchment deficit from 0.01 to 1. to make the - ! check work with perturbed parameters and initial condition - ! reichle, 16 May 01 - ! - ! IT REALLY SHOULD WORK WITH catdef > 0 (rather than >1.) ???? - ! reichle, 5 Feb 2004 - - do n=1,ncat - catdef(n)=max(1.,min(cdcr2(n),catdef(n))) - end do - - ! ------------------------------------------------------------------ - ! - ! check limits of root zone excess - ! - ! calculate root zone equilibrium moisture for given catchment deficit - - call rzequil( & - ncat, catdef, vgwmax, & - cdcr1, cdcr2, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, & - arw1, arw2, arw3, arw4, & - rzeq) - - ! assume srfexc=0 and constrain rzexc appropriately - ! (iteration would be needed to contrain srfexc and rzexc simultaneously) - - do n=1,ncat - rzexc(n)=max(wpwet(n)*vgwmax(n)-rzeq(n),min(vgwmax(n)-rzeq(n),rzexc(n))) - end do - - ! this translates into: - ! - ! wilting level < rzmc < porosity - ! - ! or more precisely: wpwet*vgwmax < rzeq+rzexc < vgwmax - ! - ! NOTE: root zone moisture is not allowed to drop below wilting level - - ! ----------------------------------------------------------------- - ! - ! Call partition() for computation of surface moisture content. - ! - ! Call to partition() also checks limits of surface excess. - ! - ! Call partition with dtstep_dummy: - ! In partition, dtstep is only used for a correction that - ! puts water into runsrf (for which runsrf_dummy is used here). - ! Also use catdef_dummy because partition() updates catdef - ! whenever srfexc exceeds physical bounds, but this is not desired here. - - runsrf_dummy = 0. - catdef_dummy = catdef - - call partition( & - ncat,dtstep_dummy,dzsf,rzexc, & - rzeq,vgwmax,cdcr1,cdcr2, & - psis,bee,poros,wpwet, & - ars1,ars2,ars3, & - ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4,.false., & - srfexc,catdef_dummy,runsrf_dummy, & - ar1, ar2, ar4,srfmx,srfmn, & - swsrf1,swsrf2,swsrf4,rzi & - ) - - ! compute surface, root zone, and profile soil moisture - - do n=1,ncat - - sfmc(n) = poros(n) * & - (swsrf1(n)*ar1(n) + swsrf2(n)*ar2(n) + swsrf4(n)*ar4(n)) - - rzmc(n) = (rzeq(n)+rzexc(n)+srfexc(n))*poros(n)/vgwmax(n) - - ! compute revised soil water storage [mm] - - prmc(n) = & - (cdcr2(n)/(1.-wpwet(n))-catdef(n)+rzexc(n)+srfexc(n)) - - ! compute error in soil water storage [mm] (if argument is present) - - if (present(werror)) werror(n)=(prmc(n)-prmc_orig(n)) - - ! convert to volumetric soil moisture - ! note: dzpr = (cdcr2/(1-wpwet)) / poros - - prmc(n) = prmc(n)*poros(n) / (cdcr2(n)/(1.-wpwet(n))) - - - ! check for negative soil moisture - - if ( (sfmc(n)<.0) .or. (rzmc(n)<.0) .or. (prmc(n)<.0) ) then - - write (*,*) 'FOUND NEGATIVE SOIL MOISTURE CONTENT.... stopping' - write (*,*) n, sfmc(n), rzmc(n), prmc(n) - stop - end if - - ! compute moisture content in unsaturated areas [m3/m3] (if arg present) - - if (ar1(n)<1.) then - - if (present(prmcun)) prmcun(n)=(prmc(n)-poros(n)*ar1(n))/(1.-ar1(n)) - if (present(rzmcun)) rzmcun(n)=(rzmc(n)-poros(n)*ar1(n))/(1.-ar1(n)) - if (present(sfmcun)) sfmcun(n)=(sfmc(n)-poros(n)*ar1(n))/(1.-ar1(n)) - - else - - if (present(prmcun)) prmcun(n)=poros(n) - if (present(rzmcun)) rzmcun(n)=poros(n) - if (present(sfmcun)) sfmcun(n)=poros(n) - - end if - - enddo - - return - - end subroutine calc_soil_moist - - SUBROUTINE PARTITION ( & - NCH,DTSTEP,DZSF,RZEXC,RZEQ,VGWMAX,CDCR1,CDCR2, & - PSIS,BEE,poros,WPWET, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4,BUG, & - srfexc,catdef,runsrf, & - AR1, AR2, AR4, srfmx, srfmn, & - SWSRF1,SWSRF2,SWSRF4,RZI & - ) - - IMPLICIT NONE - -! ------------------------------------------------------------------- - INTEGER, INTENT(IN) :: NCH - - REAL, INTENT(IN) :: DTSTEP - REAL, INTENT(IN), DIMENSION(NCH) :: DZSF,RZEXC,RZEQ,VGWMAX,CDCR1,CDCR2, & - PSIS,BEE,poros,WPWET, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4 - - LOGICAL, INTENT(IN) :: BUG -! ------------------------------------------------------------------- - REAL, INTENT(INOUT), DIMENSION(NCH) :: srfexc,catdef,runsrf -! ------------------------------------------------------------------- - REAL, INTENT(OUT), DIMENSION(NCH) :: AR1, AR2, AR4, srfmx, srfmn, & - SWSRF1, SWSRF2, SWSRF4, RZI -! ------------------------------------------------------------------- - INTEGER :: N - - REAL :: cor, A150, W150, WMIN, AX, WMNEW, WRZ, TERM1, TERM2, TERM3, & - AREA0, AREA1, AREA2, AREA3, AREA4, ASCALE, WILT, D1, D2, CDI, & - DELTA1, DELTA2, DELTA4, MULTAR, CATDEFX, RZEQX, RZEQW, FACTOR, & - X0, RZEQY, CATDEFW, AR1W, ASUM, RZEQYI, RZEQWI, RZEQXI, AR20, & - ARG1, EXPARG1, ARG2, EXPARG2, ARG3, EXPARG3 !, surflay - - LOGICAL :: LSTRESS - - - DATA LSTRESS/.FALSE./ !,surflay/20./ - -!**** -!**** -------------------------------------------------- - -!rr next line for debugging, sep 23, 2003, reichle -!rr -!rr write (*,*) 'entering partition()' - - DO N=1,NCH - - WILT=WPWET(N) - WRZ=RZEXC(N)/VGWMAX(N) - CATDEFX=AMIN1( CATDEF(N) , CDCR1(N) ) - -! CDI DEFINES IF THE SHAPE PARAMETER IS ADJUSTED IN ONE OR TWO SEGMENTS - if (ara1(n) .ne. ara3(n)) then - cdi=(ara4(n)-ara2(n))/(ara1(n)-ara3(n)) - else - cdi=0. - endif - - AR1(N)= AMIN1(1.,AMAX1(0.,(1.+ars1(n)*CATDEFX) & - /(1.+ars2(n)*CATDEFX+ars3(n)*CATDEFX*CATDEFX))) - - if (CATDEFX .ge. cdi) then - ax=ara3(n)*CATDEFX+ara4(n) - else - ax=ara1(n)*CATDEFX+ara2(n) - endif - - WMIN=AMIN1(1.,AMAX1(0.,arw4(n)+(1.-arw4(n))* & - (1.+arw1(n)*CATDEFX) & - /(1.+arw2(n)*CATDEFX+arw3(n)*CATDEFX*CATDEFX))) - -!**** CRITICAL VALUE 1: AVERAGE MOISTURE IN ROOT ZONE AT WMIN -!**** ASSOCIATED WITH CATDEF. - ARG1=AMAX1(-40., AMIN1(40., -AX*(1.-WMIN))) - EXPARG1=EXP(ARG1) - RZEQX=(WMIN-1.-(2./AX))*EXPARG1 + WMIN + (2./AX) - RZEQXI=AX*EXPARG1 * & - ( -1. -(2./AX) - (2./(AX*AX)) + WMIN + (WMIN/AX) ) & - + WMIN + 2./AX - AR20=1.+(-AX-1.+AX*WMIN)*EXPARG1 - RZEQXI=RZEQXI/(AR20+1.E-20) - -!**** CRITICAL VALUE 2: AVERAGE MOISTURE IN ROOT ZONE WHEN WMIN -!**** IS EXACTLY AT WILTING POINT. - ARG2=AMAX1(-40., AMIN1(40., -AX*(1.-WILT))) - EXPARG2=EXP(ARG2) - RZEQW=(WILT-1.-(2./AX))*EXPARG2 + WILT + (2./AX) - RZEQWI=AX*EXPARG2 * & - ( -1. -(2./AX) - (2./(AX*AX)) + WILT + (WILT/AX) ) & - + WILT + 2./AX - AR20=1.+(-AX-1.+AX*WILT)*EXPARG2 - RZEQWI=RZEQWI/(AR20+1.E-20) - -!**** SITUATION 1: CATDEF LE CDCR1 - IF(CATDEF(N) .LE. CDCR1(N)) THEN - RZEQY=RZEQX+WRZ - RZEQYI=RZEQXI+WRZ - WMNEW=WMIN+WRZ - ARG3=AMAX1(-40., AMIN1(40., -AX*(1.-WMNEW))) - EXPARG3=EXP(ARG3) - AREA1=(1.+AX-AX*WMIN)*EXPARG1 - AREA2=(1.+AX-AX*WMNEW)*EXPARG3 - IF(WMNEW .GE. WILT) THEN - AR1(N)=AR1(N)+AREA2-AREA1 - AR2(N)=1.-AR1(N) - AR4(N)=0. - ENDIF - IF(WMNEW .LT. WILT) THEN - AREA3=(1.+AX-AX*WILT)*EXPARG2 - AR1(N)=AR1(N)+AREA3-AREA1 - AR2(N)=1.-AR1(N) - FACTOR=(RZEQX+WRZ-WILT)/(RZEQW-WILT) - AR1(N)=AR1(N)*FACTOR - AR2(N)=AR2(N)*FACTOR - AR4(N)=1.-FACTOR - ENDIF - ENDIF - -!**** SITUATION 2: CATDEF GT CDCR1 - IF(CATDEF(N) .GT. CDCR1(N)) THEN - FACTOR=(CDCR2(N)-CATDEF(N))/(CDCR2(N)-CDCR1(N)) - RZEQY=WILT+(RZEQX-WILT)*FACTOR+WRZ - RZEQYI=WILT+(RZEQXI-WILT)*FACTOR+WRZ - - IF(RZEQY .LT. WILT) THEN - IF(RZEQY .LT. WILT-.001) THEN -!rr WRITE(*,*) 'RZEXC WAY TOO LOW! N=',N,' RZEQY=',RZEQY -!rr WRITE(*,*) 'SRFEXC=',SRFEXC(N),'RZEXC=',RZEXC(N), -!rr & 'CATDEF=',CATDEF(N) -! ELSE -! WRITE(*,*) 'RZEXC TOO LOW N=',N - ENDIF - RZEQY=WILT - RZEQYI=WILT - ENDIF - - IF(RZEQY .GE. RZEQX) THEN ! RZEXC BRINGS MOISTURE ABOVE CDCR1 POINT - WMNEW=WMIN+(RZEQY-RZEQX) - ARG3=AMAX1(-40., AMIN1(40., -AX*(1.-WMNEW))) - EXPARG3=EXP(ARG3) - AREA1=(1.+AX-AX*WMIN)*EXPARG1 - AREA2=(1.+AX-AX*WMNEW)*EXPARG3 - AR1(N)=AR1(N)+(AREA2-AREA1) - AR2(N)=1.-AR1(N) - AR4(N)=0. - ENDIF - - IF(RZEQY .LT. RZEQX .AND. RZEQY .GE. RZEQW) THEN - CATDEFW=CDCR2(N)+((RZEQW-WILT)/(RZEQX-WILT))*(CDCR1(N)-CDCR2(N)) - AR1W= AMIN1(1.,AMAX1(0.,(1.+ars1(n)*CATDEFW) & - /(1.+ars2(n)*CATDEFW+ars3(n)*CATDEFW*CATDEFW))) - FACTOR=(RZEQY-RZEQW)/(RZEQX-RZEQW) - AR1(N)=AR1W+FACTOR*(AR1(N)-AR1W) - AR2(N)=1.-AR1(N) - AR4(N)=0. - ENDIF - - IF(RZEQY .LT. RZEQW) THEN - CATDEFW=CDCR2(N)+((RZEQW-WILT)/(RZEQX-WILT))*(CDCR1(N)-CDCR2(N)) - AR1W= AMIN1(1.,AMAX1(0.,(1.+ars1(n)*CATDEFW) & - /(1.+ars2(n)*CATDEFW+ars3(n)*CATDEFW*CATDEFW))) - AR1(N)=AR1W - AR2(N)=1.-AR1(N) - FACTOR=(RZEQY-WILT)/(RZEQW-WILT) - AR1(N)=AR1(N)*FACTOR - AR2(N)=AR2(N)*FACTOR - AR4(N)=1.-FACTOR - ENDIF - - ENDIF - - RZI(N)=RZEQYI - - SWSRF1(N)=1. -!mjs: changed .001 temporarily because of large bee. - SWSRF2(N)=AMIN1(1., AMAX1(0.01, RZEQYI)) - SWSRF4(N)=AMIN1(1., AMAX1(0.01, WILT)) - -!**** EXTRAPOLATION OF THE SURFACE WETNESSES - -! 1st step: surface wetness in the unstressed fraction without considering -! the surface excess; we just assume an equilibrium profile from -! the middle of the root zone to the surface. - - SWSRF2(N)=((SWSRF2(N)**(-BEE(N))) - (.5/PSIS(N)))**(-1./BEE(N)) - SWSRF4(N)=((SWSRF4(N)**(-BEE(N))) - (.5/PSIS(N)))**(-1./BEE(N)) - -! srfmx is the maximum amount of water that can be added to the surface layer -! The choice of defining SWSRF4 like SWSRF2 needs to be better examined. - srfmx(n)=ar2(n)*(1.-swsrf2(n))*(dzsf(n)*poros(n)) - srfmx(n)=srfmx(n)+ar4(n)*(1.-swsrf4(n))*(dzsf(n)*poros(n)) -!**** For calculation of srfmn, assume surface moisture associated with -!**** AR1 is constantly replenished by water table. - srfmn(n)=-(ar2(n)*swsrf2(n)+ar4(n)*swsrf4(n))*(dzsf(n)*poros(n)) - - if(srfexc(n).gt.srfmx(n)) then - cor=srfexc(n)-srfmx(n) ! The correction is here - srfexc(n)=srfmx(n) - catdef(n)=catdef(n)-cor - if(catdef(n).lt.0.) then - runsrf(n)=runsrf(n)-catdef(n)/dtstep - catdef(n)=0. - endif - else if(srfexc(n).lt.srfmn(n)) then - cor=srfexc(n)-srfmn(n) - catdef(n)=catdef(n)-cor - srfexc(n)=srfmn(n) - else - cor=0. - endif - - SWSRF2(N)=SWSRF2(N)+SRFEXC(N)/(dzsf(n)*poros(n)*(1.-ar1(n))+1.e-20) - SWSRF2(N)=AMIN1(1., AMAX1(1.E-5, SWSRF2(N))) - swsrf4(n)=swsrf4(n)+srfexc(n)/(dzsf(n)*poros(n)*(1.-ar1(n))+1.e-20) - SWSRF4(N)=AMIN1(1., AMAX1(1.E-5, SWSRF4(N))) - - IF (AR1(N) .ge. 1.-1.E-5) then - AR1(N)=1. - AR2(N)=0. - AR4(N)=0. - SWSRF2(N)=1. - SWSRF4(N)=wilt - ENDIF - - IF (AR1(N) .LT. 0.) then -!rr IF(AR1(N) .LT. -1.E-3) WRITE(*,*) 'AR1 TOO LOW: AR1=',AR1(N) - AR1(N)=0. - ENDIF - ar1(n)=amax1(0., amin1(1., ar1(n))) - ar2(n)=amax1(0., amin1(1., ar2(n))) - ar4(n)=amax1(0., amin1(1., ar4(n))) - asum=ar1(n)+ar2(n)+ar4(n) - if(asum .lt. .9999 .or. asum .gt. 1.0001) then - write(*,*) 'Areas do not add to 1: sum=',asum,'N=',n - endif - - - ENDDO - - - RETURN - END SUBROUTINE PARTITION - - SUBROUTINE RZEQUIL ( & - NCH,CATDEF,VGWMAX,CDCR1,CDCR2,WPWET, & - ars1,ars2,ars3,ara1,ara2,ara3,ara4, & - arw1,arw2,arw3,arw4, & - RZEQ & - ) - - IMPLICIT NONE - - INTEGER, INTENT(IN) :: NCH - REAL, INTENT(IN), DIMENSION(NCH) :: CATDEF, VGWMAX, CDCR1, CDCR2, & - WPWET, ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, & - arw2, arw3, arw4 - - REAL, INTENT(OUT), DIMENSION(NCH) :: RZEQ - - INTEGER N - REAL AX,WMIN,ASCALE,cdi,wilt,catdefx,factor,ARG1,EXPARG1 - -! ---------------------------------------------------------------------- - - DO N=1,NCH - - WILT=WPWET(N) - CATDEFX=AMIN1( CATDEF(N) , CDCR1(N) ) - -! CDI DEFINES IF THE SHAPE PARAMETER IS ADJUSTED IN ONE OR TWO SEGMENTS - if (ara1(n) .ne. ara3(n)) then - cdi=(ara4(n)-ara2(n))/(ara1(n)-ara3(n)) - else - cdi=0. - endif - - if (CATDEFX .ge. cdi) then - ax=ara3(n)*CATDEFX+ara4(n) - else - ax=ara1(n)*CATDEFX+ara2(n) - endif - - WMIN=AMIN1(1.,AMAX1(0.,arw4(n)+(1.-arw4(n))*(1.+arw1(n)*CATDEFX) & - /(1.+arw2(n)*CATDEFX+arw3(n)*CATDEFX*CATDEFX))) - - ARG1=AMAX1(-40., AMIN1(40., -AX*(1.-WMIN))) - EXPARG1=EXP(ARG1) - RZEQ(N)=(WMIN-1.-(2./AX))*EXPARG1 + WMIN + (2./AX) - - IF(CATDEF(N) .GT. CDCR1(N)) THEN - FACTOR=(CDCR2(N)-CATDEF(N))/(CDCR2(N)-CDCR1(N)) - RZEQ(N)=WILT+(RZEQ(N)-WILT)*FACTOR - ENDIF - -! scaling: - RZEQ(N)=AMIN1(1.,AMAX1(0.,RZEQ(N))) - RZEQ(N)=RZEQ(N)*VGWMAX(N) - - ENDDO - - RETURN - END SUBROUTINE RZEQUIL - From d3d9cab51d8b28d58c09adc6523c9fb74c320530 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 28 Jan 2022 19:51:34 -0500 Subject: [PATCH 48/66] removed obsolete VEGCLS argument from catch_calc_soil_moist() and related subroutines(); fixed previous commit --- .../GEOS_CatchCNCLM40GridComp.F90 | 10 +++++----- .../GEOS_CatchCNCLM45GridComp.F90 | 16 ++++++++-------- .../GEOScatchCN_GridComp/Shared/catchcn_iau.F90 | 10 ++++------ .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 7 +++---- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 4 ++-- .../GEOScatch_GridComp/catch_incr.F90 | 10 ++++------ .../GEOScatch_GridComp/catchment.F90 | 8 ++++---- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 3 +-- .../Utils/mk_restarts/Scale_Catch.F90 | 6 +----- .../Utils/mk_restarts/Scale_CatchCN.F90 | 13 +------------ 10 files changed, 33 insertions(+), 54 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index e63f7b7aa..4749ba01a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -6436,9 +6436,9 @@ subroutine Driver ( RC ) ! gkw: obtain catchment area fractions and soil moisture ! ------------------------------------------------------ -call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & - srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc ) + call catch_calc_soil_moist( ntiles, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & + srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc ) ! obtain saturated canopy resistance following Farquhar, CLM4 implementation @@ -7313,7 +7313,7 @@ subroutine Driver ( RC ) IF ((RUN_IRRIG /= 0).AND.(ntiles >0)) THEN CALL CATCH_CALC_SOIL_MOIST ( & - NTILES,VEG1,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, CAR1, CAR2, CAR4, sfmc, rzmc, prmc) @@ -8515,7 +8515,7 @@ subroutine RUN0(gc, import, export, clock, rc) rzexccp = rzexc call catch_calc_soil_moist( & ! intent(in) - ntiles, nint(veg1), dzsf, vgwmax, cdcr1, cdcr2, & + ntiles, dzsf, vgwmax, cdcr1, cdcr2, & psis, bee, poros, wpwet, & ars1, ars2, ars3, & ara1, ara2, ara3, ara4, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 52aac23e0..593a0c850 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -6495,11 +6495,11 @@ subroutine Driver ( RC ) ! gkw: obtain catchment area fractions and soil moisture ! ------------------------------------------------------ -call catch_calc_soil_moist( ntiles, veg1, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & - srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc, & - SWSRF1OUT=SWSRF1, SWSRF2OUT=SWSRF2, SWSRF4OUT=SWSRF4 ) - + call catch_calc_soil_moist( ntiles, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & + srfexc, rzexc, catdef, car1, car2, car4, sfmc, rzmc, prmc, & + SWSRF1OUT=SWSRF1, SWSRF2OUT=SWSRF2, SWSRF4OUT=SWSRF4 ) + ! obtain saturated canopy resistance following Farquhar, CLM4 implementation @@ -7562,7 +7562,7 @@ subroutine Driver ( RC ) IF ((RUN_IRRIG /= 0).AND.(ntiles >0)) THEN CALL CATCH_CALC_SOIL_MOIST ( & - NTILES,VEG1,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, CAR1, CAR2, CAR4, sfmc, rzmc, prmc) @@ -8812,11 +8812,11 @@ subroutine RUN0(gc, import, export, clock, rc) rzexccp = rzexc call catch_calc_soil_moist( & ! intent(in) - ntiles, nint(veg1), dzsf, vgwmax, cdcr1, cdcr2, & + ntiles, dzsf, vgwmax, cdcr1, cdcr2, & psis, bee, poros, wpwet, & ars1, ars2, ars3, & ara1, ara2, ara3, ara4, & - arw1, arw2, arw3, arw4, bf1, bf2, & + arw1, arw2, arw3, arw4, bf1, bf2, & ! intent(inout) ! from process_cat srfexccp, rzexccp, catdefcp, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 index 06e05db1a..5587dc238 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchcn_iau.F90 @@ -23,7 +23,7 @@ module catchcn_iau ! *********************************************************************** subroutine apply_catchcn_iau( NTILES, & - VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & + DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & bf1, bf2, & TG1_INC, TG2_INC, TG4_INC, & @@ -40,7 +40,6 @@ subroutine apply_catchcn_iau( NTILES, & ! CATCHMENT MODEL PARAMETERS - integer, dimension( NTILES), intent(in) :: VEG real, dimension( NTILES), intent(in) :: DZSF, VGWMAX, CDCR1, CDCR2 real, dimension( NTILES), intent(in) :: PSIS, BEE, POROS, WPWET real, dimension( NTILES), intent(in) :: ARS1, ARS2, ARS3 @@ -97,7 +96,7 @@ subroutine apply_catchcn_iau( NTILES, & ! make sure that updated prognostics are OK call check_catchcn_progn( NTILES, & - VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & + DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & bf1, bf2, & TG1, TG2, TG4, TC1, TC2, TC4, QC1, QC2, QC4, & @@ -109,7 +108,7 @@ end subroutine apply_catchcn_iau ! *********************************************************************** subroutine check_catchcn_progn( NTILES, & - VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & + DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & bf1, bf2, & TG1, TG2, TG4, TC1, TC2, TC4, QC1, QC2, QC4, & @@ -136,7 +135,6 @@ subroutine check_catchcn_progn( NTILES, & ! CATCHMENT MODEL PARAMETERS - integer, dimension( NTILES), intent(in) :: VEG real, dimension( NTILES), intent(in) :: DZSF, VGWMAX, CDCR1, CDCR2 real, dimension( NTILES), intent(in) :: PSIS, BEE, POROS, WPWET real, dimension( NTILES), intent(in) :: ARS1, ARS2, ARS3 @@ -224,7 +222,7 @@ subroutine check_catchcn_progn( NTILES, & ! lower bound on catdef, - reichle, 3 Apr 2012 call catch_calc_soil_moist( & - NTILES,veg,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2, & ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 91148b8d5..841fb3dd8 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -1197,7 +1197,7 @@ SUBROUTINE CATCHCN ( & ! note revised interface - reichle, 3 Apr 2012 CALL CATCH_CALC_SOIL_MOIST ( & - nch,ityp1,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + nch,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, & AR1, AR2, AR4, & @@ -2704,7 +2704,7 @@ end subroutine catchcn_calc_tsurf_excl_snow ! ******************************************************************* - subroutine catchcn_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & + subroutine catchcn_calc_etotl( NTILES, dzsf, vgwmax, cdcr1, cdcr2, & psis, bee, poros, wpwet,bf1, bf2, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, & srfexc, rzexc, catdef, tc1, tc2, tc4, tg1, tg2, tg4, & @@ -2722,7 +2722,6 @@ subroutine catchcn_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & integer, intent(in) :: NTILES - integer, dimension( NTILES), intent(in) :: vegcls real, dimension( NTILES), intent(in) :: dzsf real, dimension( NTILES), intent(in) :: vgwmax real, dimension( NTILES), intent(in) :: cdcr1, cdcr2, bf1, bf2 @@ -2759,7 +2758,7 @@ subroutine catchcn_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & catdef_tmp = catdef ! catdef is "inout" in catch_calc_soil_moist() call catch_calc_soil_moist( & - NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + NTILES, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4,bf1, bf2,& srfexc_tmp, rzexc_tmp, catdef_tmp, ar1, ar2, ar4 ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 31a95f3cf..754b8447b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -5372,7 +5372,7 @@ subroutine Driver ( RC ) SNDZN_INCR (3,:) = SNDZN3_INCR call apply_catch_incr(NTILES, & - VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & + DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, bf1, bf2, & TCFSAT_INCR, TCFTRN_INCR, TCFWLT_INCR, QCFSAT_INCR, QCFTRN_INCR, QCFWLT_INCR, & CAPAC_INCR, CATDEF_INCR, RZEXC_INCR, SRFEXC_INCR, & @@ -6048,7 +6048,7 @@ subroutine RUN0(gc, import, export, clock, rc) rzexccp = rzexc call catch_calc_soil_moist( & ! intent(in) - ntiles, nint(ity), dzsf, vgwmax, cdcr1, cdcr2, & + ntiles, dzsf, vgwmax, cdcr1, cdcr2, & psis, bee, poros, wpwet, & ars1, ars2, ars3, & ara1, ara2, ara3, ara4, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 index 4c613a76e..e53013cf7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catch_incr.F90 @@ -22,7 +22,7 @@ module catch_incr ! *********************************************************************** subroutine apply_catch_incr( NTILES, & - VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & + DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & bf1, bf2, & TC1_INC, TC2_INC, TC4_INC, QC1_INC, QC2_INC, QC4_INC, & @@ -38,7 +38,6 @@ subroutine apply_catch_incr( NTILES, & ! CATCHMENT MODEL PARAMETERS - integer, dimension( NTILES), intent(in) :: VEG real, dimension( NTILES), intent(in) :: DZSF, VGWMAX, CDCR1, CDCR2 real, dimension( NTILES), intent(in) :: PSIS, BEE, POROS, WPWET real, dimension( NTILES), intent(in) :: ARS1, ARS2, ARS3 @@ -89,7 +88,7 @@ subroutine apply_catch_incr( NTILES, & ! make sure that updated prognostics are OK call check_catch_progn( NTILES, & - VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & + DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & bf1,bf2, & TC1, TC2, TC4, QC1, QC2, QC4, & @@ -101,7 +100,7 @@ end subroutine apply_catch_incr ! *********************************************************************** subroutine check_catch_progn( NTILES, & - VEG, DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & + DZSF, VGWMAX, CDCR1, CDCR2, PSIS, BEE, POROS, WPWET, & ARS1, ARS2, ARS3, ARA1, ARA2, ARA3, ARA4, ARW1, ARW2, ARW3, ARW4, & bf1,bf2, & TC1, TC2, TC4, QC1, QC2, QC4, & @@ -128,7 +127,6 @@ subroutine check_catch_progn( NTILES, & ! CATCHMENT MODEL PARAMETERS - integer, dimension( NTILES), intent(in) :: VEG real, dimension( NTILES), intent(in) :: DZSF, VGWMAX, CDCR1, CDCR2 real, dimension( NTILES), intent(in) :: PSIS, BEE, POROS, WPWET real, dimension( NTILES), intent(in) :: ARS1, ARS2, ARS3 @@ -215,7 +213,7 @@ subroutine check_catch_progn( NTILES, & ! lower bound on catdef, - reichle, 3 Apr 2012 call catch_calc_soil_moist( & - NTILES,veg,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2, & ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 768b189ad..b1b9940e3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -1210,7 +1210,7 @@ SUBROUTINE CATCHMENT ( & ! note revised interface - reichle, 3 Apr 2012 CALL CATCH_CALC_SOIL_MOIST ( & - nch,ityp,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + nch,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2,ara3,ara4,arw1,arw2,arw3,arw4,bf1,bf2, & srfexc,rzexc,catdef, & AR1, AR2, AR4, & @@ -3271,9 +3271,9 @@ subroutine catch_calc_etotl( NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, & rzexc_tmp = rzexc ! rzexc is "inout" in catch_calc_soil_moist() catdef_tmp = catdef ! catdef is "inout" in catch_calc_soil_moist() - call catch_calc_soil_moist( & - NTILES, vegcls, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & - ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & + call catch_calc_soil_moist( & + NTILES, dzsf, vgwmax, cdcr1, cdcr2, psis, bee, poros, wpwet, & + ars1, ars2, ars3, ara1, ara2, ara3, ara4, arw1, arw2, arw3, arw4, bf1, bf2, & srfexc_tmp, rzexc_tmp, catdef_tmp, ar1, ar2, ar4 ) ! compute snow-free tsurf diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 1b6c27c9d..656852195 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -1536,7 +1536,7 @@ END SUBROUTINE SIBALB ! ================================================================================ subroutine catch_calc_soil_moist( & - NTILES,vegcls,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & + NTILES,dzsf,vgwmax,cdcr1,cdcr2,psis,bee,poros,wpwet, & ars1,ars2,ars3,ara1,ara2, & ara3,ara4,arw1,arw2,arw3,arw4,bf1, bf2, & srfexc,rzexc,catdef, & @@ -1590,7 +1590,6 @@ subroutine catch_calc_soil_moist( & implicit none integer, intent(in) :: NTILES - integer, dimension(NTILES), intent(in) :: vegcls real, dimension(NTILES), intent(in) :: dzsf,vgwmax,cdcr1,cdcr2 real, dimension(NTILES), intent(in) :: wpwet,poros,psis diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index bd5a1b238..66dedbf04 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -93,7 +93,6 @@ program Scale_Catch type(catch_rst) catch(3) real, allocatable, dimension(:) :: dzsf, ar1, ar2, ar4 - integer, allocatable, dimension(:) :: vegcls real, allocatable, dimension(:,:) :: TP_IN, GHT_IN, FICE, GHT_OUT, TP_OUT real, allocatable, dimension(:) :: swe_in, depth_in, areasc_in, areasc_out, depth_out @@ -188,9 +187,6 @@ program Scale_Catch call readcatch ( 20,catch(new) ) end if - allocate( vegcls(ntiles) ) - vegcls(:) = catch(new)%ity(:) - ! Create Scaled Catch ! ------------------- sca = 3 @@ -251,7 +247,7 @@ program Scale_Catch dzsf = SURFLAY - call catch_calc_soil_moist( ntiles, vegcls, dzsf, & + call catch_calc_soil_moist( ntiles, dzsf, & catch(sca)%vgwmax, catch(sca)%cdcr1, catch(sca)%cdcr2, & catch(sca)%psis, catch(sca)%bee, catch(sca)%poros, catch(sca)%wpwet, & catch(sca)%ars1, catch(sca)%ars2, catch(sca)%ars3, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index 25fc9368c..5d505b49b 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -124,7 +124,6 @@ program Scale_CatchCN type(catch_rst) catch(3) real, allocatable, dimension(:) :: dzsf, ar1, ar2, ar4 - integer, allocatable, dimension(:) :: veg1 real, allocatable, dimension(:,:) :: TP_IN, GHT_IN, FICE, GHT_OUT, TP_OUT real, allocatable, dimension(:) :: swe_in, depth_in, areasc_in, areasc_out, depth_out @@ -230,16 +229,6 @@ program Scale_CatchCN ! call readcatchcn ( 20,catch(new) ) end if - - allocate( veg1(ntiles) ) - - where(ITY(:,1) > 0.) - VEG1 = map_cat(nint(catch(new)%ITY(:,1))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 - elsewhere - VEG1 = map_cat(nint(catch(new)%ITY(:,2))) ! gkw: primary CN PFT type mapped to catchment type; ITY should be > 0 even if FVEG=0 - endwhere - - ! Create Scaled Catch ! ------------------- sca = 3 @@ -300,7 +289,7 @@ program Scale_CatchCN dzsf = SURFLAY - call catch_calc_soil_moist( ntiles, veg1, dzsf, & + call catch_calc_soil_moist( ntiles, dzsf, & catch(sca)%vgwmax, catch(sca)%cdcr1, catch(sca)%cdcr2, & catch(sca)%psis, catch(sca)%bee, catch(sca)%poros, catch(sca)%wpwet, & catch(sca)%ars1, catch(sca)%ars2, catch(sca)%ars3, & From 192ce62b31cf75e9d90acd581d03973b95369a36 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 28 Jan 2022 22:29:43 -0500 Subject: [PATCH 49/66] fixing bug in previous commit --- .../GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 | 1 + .../GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 | 1 + 2 files changed, 2 insertions(+) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index 66dedbf04..b00959c07 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -253,6 +253,7 @@ program Scale_Catch catch(sca)%ars1, catch(sca)%ars2, catch(sca)%ars3, & catch(sca)%ara1, catch(sca)%ara2, catch(sca)%ara3, catch(sca)%ara4, & catch(sca)%arw1, catch(sca)%arw2, catch(sca)%arw3, catch(sca)%arw4, & + catch(sca)%bf1, catch(sca)%bf2, & catch(sca)%srfexc, catch(sca)%rzexc, catch(sca)%catdef, & ar1, ar2, ar4 ) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index 5d505b49b..7edbf52e4 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -295,6 +295,7 @@ program Scale_CatchCN catch(sca)%ars1, catch(sca)%ars2, catch(sca)%ars3, & catch(sca)%ara1, catch(sca)%ara2, catch(sca)%ara3, catch(sca)%ara4, & catch(sca)%arw1, catch(sca)%arw2, catch(sca)%arw3, catch(sca)%arw4, & + catch(sca)%bf1, catch(sca)%bf2, & catch(sca)%srfexc, catch(sca)%rzexc, catch(sca)%catdef, & ar1, ar2, ar4 ) From dcdad2414005537c6cc7205eded5ddf64ed8c39d Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 29 Jan 2022 10:12:27 -0500 Subject: [PATCH 50/66] fixed bug in previous commit --- .../GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index 7edbf52e4..cf988485f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -14,9 +14,6 @@ program Scale_CatchCN USE CATCH_CONSTANTS, ONLY: & N_GT => CATCH_N_GT, & PEATCLSM_POROS_THRESHOLD - - USE CLM_VARPAR, ONLY: & - MAP_CAT implicit none From 30f91a38192e5250c83eb609c36f2981773cc700 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 29 Jan 2022 12:54:17 -0500 Subject: [PATCH 51/66] introduced function for zbar calculations; removed redundant zbar calculations --- .../GEOS_CatchCNCLM40GridComp.F90 | 9 ++-- .../GEOS_CatchCNCLM45GridComp.F90 | 9 ++-- .../Shared/catchmentCN.F90 | 42 +++++++++-------- .../GEOScatch_GridComp/catchment.F90 | 47 ++++++++++--------- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 30 ++++++++++-- 5 files changed, 82 insertions(+), 55 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 4749ba01a..ee32af71f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -61,7 +61,7 @@ module GEOS_CatchCNCLM40GridCompMod use MAPL_ConstantsMod,only: Tzero => MAPL_TICE, pi => MAPL_PI use clm_time_manager, only: get_days_per_year, get_step_size use pftvarcon, only: noveg - USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, irrigation_rate + USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, catch_calc_zbar, irrigation_rate implicit none private @@ -6564,9 +6564,11 @@ subroutine Driver ( RC ) ! soil temperatures ! ----------------- - zbar = -sqrt(1.e-20+catdef(n)/bf1(n))+bf2(n) + + ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTMP_CN) + ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) HT(:)=GHTCNT(:,N) - CALL GNDTMP_CN(poros(n),zbar,ht,frice,tp,soilice) + CALL GNDTMP_CN(poros(n),-1.*zbar,ht,frice,tp,soilice) ! note minus sign for zbar ! At the CatchCNGridComp level, tp1, tp2, .., tp6 are export variables in units of Kelvin, ! - rreichle & borescan, 6 Nov 2020 @@ -6585,7 +6587,6 @@ subroutine Driver ( RC ) ! baseflow ! -------- - zbar = sqrt(1.e-20+catdef(n)/bf1(n))-bf2(n) bflow(n) = (1.-frice)*1000.* & cond(n)*exp(-(bf3(n)-ashift)-gnu(n)*zbar)/gnu(n) IF(catdef(n) >= cdcr1(n)) bflow(n) = 0. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 593a0c850..dc47c5a80 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -61,7 +61,7 @@ module GEOS_CatchCNCLM45GridCompMod use MAPL_ConstantsMod,only: Tzero => MAPL_TICE, pi => MAPL_PI use clm_time_manager, only: get_days_per_year, get_step_size use pftvarcon, only: noveg - USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, irrigation_rate + USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, catch_calc_zbar, irrigation_rate use update_model_para4cn, only : upd_curr_date_time implicit none @@ -6642,9 +6642,11 @@ subroutine Driver ( RC ) ! soil temperatures ! ----------------- - zbar = -sqrt(1.e-20+catdef(n)/bf1(n))+bf2(n) + + ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTMP_CN) + ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) HT(:)=GHTCNT(:,N) - CALL GNDTMP_CN(poros(n),zbar,ht,frice,tp,soilice) + CALL GNDTMP_CN(poros(n),-1.*zbar,ht,frice,tp,soilice) ! note minus sign for zbar ! At the CatchCNGridComp level, tp1, tp2, .., tp6 are export variables in units of Kelvin, ! - rreichle & borescan, 6 Nov 2020 @@ -6663,7 +6665,6 @@ subroutine Driver ( RC ) ! baseflow ! -------- - zbar = sqrt(1.e-20+catdef(n)/bf1(n))-bf2(n) bflow(n) = (1.-frice)*1000.* & cond(n)*exp(-(bf3(n)-ashift)-gnu(n)*zbar)/gnu(n) IF(catdef(n) >= cdcr1(n)) bflow(n) = 0. diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 841fb3dd8..db89b50f7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -91,15 +91,16 @@ MODULE CATCHMENT_CN_MODEL PEATCLSM_POROS_THRESHOLD, & PEATCLSM_ZBARMAX_4_SYSOIL - USE SURFPARAMS, ONLY: CSOIL_2, RSWILT, & - LAND_FIX, FLWALPHA + USE SURFPARAMS, ONLY: CSOIL_2, RSWILT, & + LAND_FIX, FLWALPHA - USE lsm_routines, only : & - INTERC, BASE, PARTITION, RZEQUIL, gndtp0, & - catch_calc_soil_moist, gndtmp, & - catch_calc_wtotl, dampen_tc_oscillations, & - PHIGT, DZTC, DZGT, FSN, SRUNOFF + USE lsm_routines, only : & + INTERC, BASE, PARTITION, RZEQUIL, & + gndtp0, gndtmp, & + catch_calc_soil_moist, catch_calc_zbar, & + catch_calc_wtotl, dampen_tc_oscillations, & + PHIGT, DZTC, DZGT, FSN, SRUNOFF USE SIBALB_COEFF, ONLY: coeffsib @@ -278,7 +279,7 @@ SUBROUTINE CATCHCN ( & REAL, DIMENSION(N_SM) :: T1, AREA, tkgnd, fhgnd - REAL :: TG1SN, TG2SN, TG4SN, DTG1SN,DTG2SN,DTG4SN, ZBAR, THETAF, & + REAL :: TG1SN, TG2SN, TG4SN, DTG1SN,DTG2SN,DTG4SN, ZBAR, THETAF, & XFICE, FH21, FH21W, FH21I, FH21D, DFH21W, DFH21I, DFH21D, & EVSN, SHFLS, HUPS, HCORR, SWNET0, HLWDWN0, TMPSNW, HLWTC, & DHLWTC, HSTURB, DHSDEA, DHSDTC, ESATTC, ETURB, DEDEA, DEDTC, & @@ -684,16 +685,17 @@ SUBROUTINE CATCHCN ( & else phi=PHIGT end if - ZBAR=-SQRT(1.e-20+catdef(n)/bf1(n))+bf2(n) + ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTP0) + ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) THETAF=.5 DO LAYER=1,6 HT(LAYER)=GHTCNT(LAYER,N) ENDDO - CALL GNDTP0( & - T1,phi,ZBAR,THETAF, & - HT, & - fh21w,fH21i,fh21d,dfh21w,dfh21i,dfh21D,tp & + CALL GNDTP0( & + T1,phi,-1.*ZBAR,THETAF, & ! note minus sign for zbar + HT, & + fh21w,fH21i,fh21d,dfh21w,dfh21i,dfh21D,tp & ) HFTDS1(N)=-FH21W @@ -1050,16 +1052,17 @@ SUBROUTINE CATCHCN ( & else phi=PHIGT end if - ZBAR=-SQRT(1.e-20+catdef(n)/bf1(n))+bf2(n) + ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTMP) + ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) THETAF=.5 DO LAYER=1,6 HT(LAYER)=GHTCNT(LAYER,N) ENDDO FH21=-GHFLUX(N) - CALL GNDTMP( & - dtstep,phi,zbar,thetaf,fh21, & - ht, & + CALL GNDTMP( & + dtstep,phi,-1.*zbar,thetaf,fh21, & ! note minus sign for zbar + ht, & xfice,tp, soilice) DO LAYER=1,6 @@ -1769,7 +1772,7 @@ SUBROUTINE RZDRAIN ( & ! to avoid extrapolation errors due to the non-optimal ! (linear) approximation with the bf1-bf2-CLSM function, ! theoretical SYSOIL curve levels off approximately at 0 m and 0.45 m. - ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + ZBAR1 = catch_calc_zbar( BF1(N), BF2(N), CATDEF(N) ) SYSOIL = (2.*bf1(n)*amin1(amax1(zbar1,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(n)*bf2(n))/1000. ! Calculate fraction of RZFLW removed/added to catdef RZFLW_CATDEF = (1.-AR1eq)*SYSOIL*RZFLW/(1.*AR1eq+SYSOIL*(1.-AR1eq)) @@ -2373,7 +2376,6 @@ SUBROUTINE WUPDAT ( & !**** ----------------------------------------------------------------- DO 100 N = 1, NCH - ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) !**** !**** PARTITION EVAP BETWEEN INTERCEPTION AND GROUND RESERVOIRS. !**** @@ -2426,7 +2428,7 @@ SUBROUTINE WUPDAT ( & ! MB: accounting for water ponding on AR1 ! same approach as for RZFLW (see subroutine RZDRAIN for ! comments) - ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + ZBAR1 = catch_calc_zbar( BF1(N), BF2(N), CATDEF(N) ) SYSOIL = (2.*bf1(N)*amin1(amax1(zbar1,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(N)*bf2(N))/1000. SYSOIL = amin1(SYSOIL,poros(N)) ET_CATDEF = SYSOIL*(EVSURF(N) + EVROOT(N))*ESATFR(N)/(1.*AR1(N)+SYSOIL*(1.-AR1(N))) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index b1b9940e3..bb26e5e3f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -95,11 +95,12 @@ MODULE CATCHMENT_MODEL LAND_FIX, ASTRFR, STEXP, RSWILT, & FLWALPHA, CSOIL_2 - USE lsm_routines, only : & - INTERC, BASE, PARTITION, RZEQUIL, gndtp0, & - catch_calc_soil_moist, gndtmp, & - catch_calc_wtotl, dampen_tc_oscillations, & - PHIGT, DZTC, SRUNOFF + USE lsm_routines, only : & + INTERC, BASE, PARTITION, RZEQUIL, & + gndtp0, gndtmp, & + catch_calc_soil_moist, catch_calc_zbar, & + catch_calc_wtotl, dampen_tc_oscillations, & + PHIGT, DZTC, SRUNOFF USE SIBALB_COEFF, ONLY: coeffsib @@ -684,23 +685,22 @@ SUBROUTINE CATCHMENT ( & else phi=PHIGT end if -!#ifdef LAND_UPD if (LAND_FIX) then - ZBAR =-SQRT(1.e-20+catdef(n)/bf1(n))+bf2(n) ! zbar bug fix, - reichle, 16 Nov 2015 - else -!#else - ZBAR=-SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) + ! zbar bug fix, - reichle, 16 Nov 2015 + ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTP0) + ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) + else + ZBAR=-SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) end if -!#endif THETAF=.5 DO LAYER=1,6 HT(LAYER)=GHTCNT(LAYER,N) ENDDO - CALL GNDTP0( & - T1,phi,ZBAR,THETAF, & - HT, & - fh21w,fH21i,fh21d,dfh21w,dfh21i,dfh21D,tp & + CALL GNDTP0( & + T1,phi,-1.*ZBAR,THETAF, & ! note minus sign for zbar + HT, & + fh21w,fH21i,fh21d,dfh21w,dfh21i,dfh21D,tp & ) HFTDS1(N)=-FH21W @@ -1033,7 +1033,7 @@ SUBROUTINE CATCHMENT ( & GHFLUX(N)=(1.-ASNOW(N))* & (GHFLUX1(N)*AR1(N)+GHFLUX2(N)*AR2(N)+GHFLUX4(N)*AR4(N)) & +ASNOW(N)*GHFLUXS(N) - GHTSKIN(N)=(1.-ASNOW(N))* & + GHTSKIN(N)=(1.-ASNOW(N))* & (GHFLUX1(N)*AR1(N)+GHFLUX2(N)*AR2(N)+GHFLUX4(N)*AR4(N)) & -ASNOW(N)*ghfluxsno(N) ENDDO @@ -1054,7 +1054,9 @@ SUBROUTINE CATCHMENT ( & phi=PHIGT end if if (LAND_FIX) then - ZBAR =-SQRT(1.e-20+catdef(n)/bf1(n))+bf2(n) ! zbar bug fix, - reichle, 16 Nov 2015 + ! zbar bug fix, - reichle, 16 Nov 2015 + ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTMP) + ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) else ZBAR=-SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) end if @@ -1064,9 +1066,9 @@ SUBROUTINE CATCHMENT ( & ENDDO FH21=-GHFLUX(N) - CALL GNDTMP( & - dtstep,phi,zbar,thetaf,fh21, & - ht, & + CALL GNDTMP( & + dtstep,phi,-1.*zbar,thetaf,fh21, & ! note minus sign for zbar + ht, & xfice,tp, soilice) DO LAYER=1,6 @@ -1808,7 +1810,7 @@ SUBROUTINE RZDRAIN ( & ! to avoid extrapolation errors due to the non-optimal ! (linear) approximation with the bf1-bf2-CLSM function, ! theoretical SYSOIL curve levels off approximately at 0 m and 0.45 m. - ZBAR1=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + ZBAR1 = catch_calc_zbar( BF1(N), BF2(N), CATDEF(N) ) SYSOIL = (2.*bf1(n)*amin1(amax1(zbar1,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(n)*bf2(n))/1000. SYSOIL = amin1(SYSOIL,poros(n)) ! Calculate fraction of RZFLW removed/added to catdef @@ -2848,7 +2850,6 @@ SUBROUTINE WUPDAT ( & !**** !**** ----------------------------------------------------------------- DO 100 CHNO = 1, NCH - ZBAR1=SQRT(1.e-20+CATDEF(CHNO)/BF1(CHNO))-BF2(CHNO) !**** COMPUTE EFFECTIVE SURFACE CONDUCTANCES IN SATURATED AND UNSATURATED !**** AREAS: @@ -2937,7 +2938,7 @@ SUBROUTINE WUPDAT ( & ! MB: accounting for water ponding on AR1 ! same approach as for RZFLW (see subroutine RZDRAIN for ! comments) - ZBAR1=SQRT(1.e-20+CATDEF(CHNO)/BF1(CHNO))-BF2(CHNO) + ZBAR1 = catch_calc_zbar( BF1(CHNO), BF2(CHNO), CATDEF(CHNO) ) SYSOIL = (2.*bf1(CHNO)*amin1(amax1(zbar1,0.),PEATCLSM_ZBARMAX_4_SYSOIL) + 2.*bf1(CHNO)*bf2(CHNO))/1000. SYSOIL = amin1(SYSOIL,poros(CHNO)) ET_CATDEF = SYSOIL*(ESOI(CHNO) + EVEG(CHNO))*ESATFR/(1.*AR1(CHNO)+SYSOIL*(1.-AR1(CHNO))) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 656852195..73d48dab9 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -66,7 +66,7 @@ MODULE lsm_routines PRIVATE PUBLIC :: INTERC, BASE, PARTITION, RZEQUIL, gndtp0 - PUBLIC :: SIBALB, catch_calc_soil_moist, catch_calc_subtile2tile + PUBLIC :: SIBALB, catch_calc_soil_moist, catch_calc_zbar, catch_calc_subtile2tile PUBLIC :: gndtmp, catch_calc_tp, catch_calc_ght, catch_calc_FT, catch_calc_wtotl PUBLIC :: dampen_tc_oscillations, lsmroutines_echo_constants, irrigation_rate, SRUNOFF @@ -503,8 +503,7 @@ SUBROUTINE BASE ( & data ashift/0./ DO N=1,NCH - ! note intentionally opposite sign w.r.t. zbar defined above, - reichle, 16 Nov 2015 - ZBAR=SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) + ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) IF (POROS(N) < PEATCLSM_POROS_THRESHOLD) THEN BFLOW(N)=(1.-FRICE(N))*1000.* & cond(n)*exp(-(bf3(n)-ashift)-gnu(n)*zbar)/gnu(n) @@ -752,7 +751,7 @@ SUBROUTINE PARTITION ( & ! peat ! MB: AR4 (wilting fraction) for peatland depending on water table depth !ZBAR defined here positive below ground and in meter - ZBAR=SQRT(1.e-20+CATDEF(N)/BF1(N))-BF2(N) + ZBAR = catch_calc_zbar( BF1(N), BF2(N), CATDEF(N) ) AR4(N)=amax1(0.,amin1(1.0,(ZBAR-0.30)/(1.0))) ARREST = 1.0 - AR1(N) AR4(N)=amin1(ARREST,AR4(N)) @@ -1767,6 +1766,29 @@ end subroutine catch_calc_soil_moist ! ******************************************************************* + real function catch_calc_zbar( bf1, bf2, catdef ) + + ! Calculate zbar for Catchment[CN] model. + ! + ! Convention: zbar positive below ground (downward). + ! + ! This convention applies to water calculations, incl. subroutines RZDRAIN(), + ! WUPDAT(), BASE(), PEATCLSM + ! + ! WARNING: + ! Opposite convention applies when zbar is used in ground heat + ! diffusion model, incl. subroutines GNDTP0(), GNDTMP(), GNDTMP_CN(). + ! + ! - reichle, 29 Jan 2022 + + real, intent(in) :: bf1, bf2, catdef + + catch_calc_bar = SQRT(1.e-20 + catdef/bf1) - bf2 + + end function catch_calc_zbar + + ! ******************************************************************* + subroutine catch_calc_subtile2tile( NTILES, ar1, ar2, asnow, subtile_data, tile_data ) ! average from subtile space to tile-average From f10f98ec5ac52cdba2d7949255fbea8cf7123b18 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sat, 29 Jan 2022 13:39:51 -0500 Subject: [PATCH 52/66] fixed bug in previous commit --- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 73d48dab9..d837d7913 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -1783,7 +1783,7 @@ real function catch_calc_zbar( bf1, bf2, catdef ) real, intent(in) :: bf1, bf2, catdef - catch_calc_bar = SQRT(1.e-20 + catdef/bf1) - bf2 + catch_calc_zbar = SQRT(1.e-20 + catdef/bf1) - bf2 end function catch_calc_zbar From 65c2fb665fdecf9574653f8a0a719d35de4b96e7 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sun, 30 Jan 2022 09:20:26 -0500 Subject: [PATCH 53/66] restrict addition of 1e-20 to area(1) to peat tiles to maintain 0-diff of old physics --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 4 ++-- .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index db89b50f7..ffada35fb 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -802,8 +802,8 @@ SUBROUTINE CATCHCN ( & T1(1) = TG1(N)-TF T1(2) = TG2(N)-TF T1(3) = TG4(N)-TF - ! MB: to handle division by zero in PEATCLSM equations - AREA(1)= amax1(AR1(N),2.E-20) + ! MB: avoid division by zero (AR1=0) in PEATCLSM equations + IF(POROS(N) >= PEATCLSM_POROS_THRESHOLD) AREA(1)= amax1(AR1(N),2.E-20) AREA(2)= AR2(N) AREA(3)= AR4(N) pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index bb26e5e3f..bf2d6d5ae 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -832,8 +832,8 @@ SUBROUTINE CATCHMENT ( & T1(1) = TC1(N)-TF T1(2) = TC2(N)-TF T1(3) = TC4(N)-TF - ! MB: to handle division by zero in PEATCLSM equations - AREA(1)= amax1(AR1(N),2.E-20) + ! MB: avoid division by zero (AR1=0) in PEATCLSM equations + IF(POROS(N) >= PEATCLSM_POROS_THRESHOLD) AREA(1)= amax1(AR1(N),2.E-20) AREA(2)= AR2(N) AREA(3)= AR4(N) pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) From 59e312179f8e043a5ff8122cbc4f03e48d0a2240 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sun, 30 Jan 2022 11:11:50 -0500 Subject: [PATCH 54/66] fixed error in previous commit --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 6 +++++- .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index ffada35fb..c61cb1295 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -803,7 +803,11 @@ SUBROUTINE CATCHCN ( & T1(2) = TG2(N)-TF T1(3) = TG4(N)-TF ! MB: avoid division by zero (AR1=0) in PEATCLSM equations - IF(POROS(N) >= PEATCLSM_POROS_THRESHOLD) AREA(1)= amax1(AR1(N),2.E-20) + IF(POROS(N) >= PEATCLSM_POROS_THRESHOLD) THEN + AREA(1)= amax1(AR1(N),2.E-20) + ELSE + AREA(1) = AR1(N) + END IF AREA(2)= AR2(N) AREA(3)= AR4(N) pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index bf2d6d5ae..34df13dec 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -833,7 +833,11 @@ SUBROUTINE CATCHMENT ( & T1(2) = TC2(N)-TF T1(3) = TC4(N)-TF ! MB: avoid division by zero (AR1=0) in PEATCLSM equations - IF(POROS(N) >= PEATCLSM_POROS_THRESHOLD) AREA(1)= amax1(AR1(N),2.E-20) + IF(POROS(N) >= PEATCLSM_POROS_THRESHOLD) THEN + AREA(1)= amax1(AR1(N),2.E-20) + ELSE + AREA(1) = AR1(N) + END IF AREA(2)= AR2(N) AREA(3)= AR4(N) pr = trainc(n)+trainl(n)+tsnow(n)+tice(n)+tfrzr(n) From e44b03ba48a35a6f9b036783f15b0d89165d97e0 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Sun, 30 Jan 2022 14:17:47 -0500 Subject: [PATCH 55/66] replacing hardwired 0.05 with named constant DZTC in gndtmp_cn() (catchmentCN.F90) --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index c61cb1295..d2550fcd6 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -2558,8 +2558,8 @@ subroutine gndtmp_cn(poros, zbar, ht, xfice, tp, FICE) ! calculate the boundaries, based on the layer thicknesses(DZGT) - zb(1)=-0.05 ! Bottom of surface layer, which is handled outside - ! this routine. + zb(1)=-DZTC ! Bottom of surface layer, which is handled outside + ! this routine. do l=1,N_GT zb(l+1)=zb(l)-DZGT(l) shc(l)=SHR0*(1.-phi)*DZGT(l) From e4a82348db4360bedacf4537aae17c71a25b65f6 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 1 Feb 2022 17:45:52 -0500 Subject: [PATCH 56/66] fixing errors in manual merge of branch feature/rreichle/cleancatchconstants into feature/borescan_merge_sm_peat --- .../GEOSland_GridComp/Shared/catch_constants.f90 | 1 - .../GEOSland_GridComp/Shared/lsm_routines.F90 | 9 --------- 2 files changed, 10 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 index be74249ba..5594f337b 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 @@ -203,7 +203,6 @@ subroutine echo_catch_constants(logunit) end subroutine echo_catch_constants ! ******************************************************************************* ->>>>>>> feature/rreichle/cleancatchconstants end module catch_constants diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 711e6326c..18fe158ae 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -78,17 +78,8 @@ MODULE lsm_routines REAL, PARAMETER :: CATCH_FT_THRESHOLD_TEFF = TF ! [Kelvin] REAL, PARAMETER :: CATCH_FT_THRESHOLD_ASNOW = 0.2 ! -<<<<<<< HEAD - REAL, PARAMETER :: CATCH_FT_WEIGHT_TP1 = 0.5 ! - REAL, PARAMETER :: CATCH_FT_THRESHOLD_TEFF = TF ! [Kelvin] - REAL, PARAMETER :: CATCH_FT_THRESHOLD_ASNOW = 0.2 ! - - REAL, PARAMETER :: ZERO = 0. - REAL, PARAMETER :: ONE = 1. -======= REAL, PARAMETER :: ZERO = 0. REAL, PARAMETER :: ONE = 1. ->>>>>>> feature/rreichle/cleancatchconstants CONTAINS From b3aa6bd1820d1b8534bcc27b598bbaec47519e97 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 2 Feb 2022 09:35:00 -0500 Subject: [PATCH 57/66] renamed DZTC to DZTSURF to avoid inconsistency with CatchCN's TC vs. TG --- .../CLM45/CN_DriverMod.F90 | 6 +++--- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 8 ++++---- .../GEOScatch_GridComp/catchment.F90 | 4 ++-- .../Shared/catch_constants.f90 | 17 ++++++++++++----- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 10 +++++----- 5 files changed, 26 insertions(+), 19 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90 index 8cad3d43a..a9769a60f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/CLM45/CN_DriverMod.F90 @@ -29,7 +29,7 @@ module CN_DriverMod #else use CNDecompCascadeMod_CENTURY, only : init_decompcascade #endif - use catch_constants, only: DZTC=>CATCH_DZTC, DZGT=>CATCH_DZGT + use catch_constants, only: DZTSURF=>CATCH_DZTSURF, DZGT=>CATCH_DZGT use SurfParams, only: LAND_FIX ! use update_model_para4cn, only : LocalTileID, upd_tileid ! useful for debugging @@ -230,7 +230,7 @@ subroutine CN_Driver(istep,nch,nveg,nzone,daylength, & real, pointer :: psisat(:,:) !soil water potential at saturation for CN code (MPa) real, pointer :: psiwilt(:) !root-zone soil water potential at wilting point (MPa) real, pointer :: soilpsi(:,:) !soil water potential in each soil layer (MPa) - real, pointer :: h2osoi_liq(:,:) !column liquid water (kg/m2) (new) + real, pointer :: h2osoi_liq(:,:) !column liquid water (kg/m2) (new) real, pointer :: wf(:) !soil water as frac. of whc for top 0.05 m real, pointer :: wf2(:) !soil water as frac. of whc for top 0.17 m real, pointer :: qflx_drain(:) !sub-surface runoff (mm H2O /s) @@ -639,7 +639,7 @@ subroutine CN_Driver(istep,nch,nveg,nzone,daylength, & ! ---------------- t_soisno(n,1) = tp1(nc) ! soil layer temperature (K) t_grnd(n) = tgw(nc,nz) ! ground surface temperature (K) - tsoi17(n) = (DZTC*tgw(nc,nz)+(DZGT(1)-DZTC)*tp1(nc)+(0.17-DZGT(1))*tp2(nc))/0.17 ! soil temperature in top 17cm of soil (Kelvin) + tsoi17(n) = (DZTSURF*tgw(nc,nz)+(DZGT(1)-DZTSURF)*tp1(nc)+(0.17-DZGT(1))*tp2(nc))/0.17 ! soil temperature in top 17cm of soil (Kelvin) ! fzeng: tgw is for the top 5cm; tp1 is for the 2nd 5cm; tp2 is for the next 10cm ! see Koster et al., 2000, JGR ! The depths are hard coded here. Improve this? diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 7f6979d66..3f33af11f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -93,7 +93,7 @@ MODULE CATCHMENT_CN_MODEL N_sm => CATCH_N_ZONES, & SATCAPFR => CATCH_SATCAPFR, & PHIGT => CATCH_PHIGT, & - DZTC => CATCH_DZTC, & + DZTSURF => CATCH_DZTSURF, & DZGT => CATCH_DZGT, & FSN => CATCH_FSN, & PEATCLSM_POROS_THRESHOLD, & @@ -831,7 +831,7 @@ SUBROUTINE CATCHCN ( & tkgnd(2)=1.8 tkgnd(3)=1.8 raddn=hlwdwn(n)+swnets(n) - zc1=-(DZTC*0.5) + zc1=-(DZTSURF*0.5) hups=0.0 !**** 1. RUN SNOW MODEL: @@ -2565,8 +2565,8 @@ subroutine gndtmp_cn(poros, zbar, ht, xfice, tp, FICE) ! calculate the boundaries, based on the layer thicknesses(DZGT) - zb(1)=-DZTC ! Bottom of surface layer, which is handled outside - ! this routine. + zb(1)=-DZTSURF ! Bottom of surface layer, which is handled outside + ! this routine. do l=1,N_GT zb(l+1)=zb(l)-DZGT(l) shc(l)=SHR0*(1.-phi)*DZGT(l) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 11a98050d..040f0a327 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -92,7 +92,7 @@ MODULE CATCHMENT_MODEL N_sm => CATCH_N_ZONES, & SATCAPFR => CATCH_SATCAPFR, & PHIGT => CATCH_PHIGT, & - DZTC => CATCH_DZTC, & + DZTSURF => CATCH_DZTSURF, & PEATCLSM_POROS_THRESHOLD, & PEATCLSM_ZBARMAX_4_SYSOIL @@ -857,7 +857,7 @@ SUBROUTINE CATCHMENT ( & tkgnd(2)=1.8 tkgnd(3)=1.8 raddn=hlwdwn(n)+swnets(n) - zc1=-(DZTC*0.5) + zc1=-(DZTSURF*0.5) hups=0.0 !**** 1. RUN SNOW MODEL: diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 index 5594f337b..59da08ac5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 @@ -70,9 +70,11 @@ module catch_constants ! --------------------------------------------------------------------------- ! - ! layer depth associated with snow-free land temperatures + ! layer depth associated with snow-free land surface soil temperatures ! - ! Note: DZTC = .05 is a hardwired setting of the depth of the bottom of + ! ================== + ! Note by Randy Koster & Rolf Reichle when CSOIL=200. was still used (~2018): + ! DZTC = .05 is a hardwired setting of the depth of the bottom of ! the surface soil layer. It should be made a parameter that is tied to ! the heat capacity CSOIL, which had been set to either CSOIL_1 or ! CSOIL_2 based on vegetation type. For now we leave @@ -87,8 +89,13 @@ module catch_constants ! are other impacts in wet climates regarding the effect of ! the depth of the water table on the thermal conductivity; these impacts ! are presumably very small. - - REAL, PARAMETER, PUBLIC :: CATCH_DZTC = 0.05 ! m layer depth for tc1, tc2, tc4 + ! ================== + ! + ! DZTSURF (formerly DZTC) is the layer depth associated w/ surface soil temperatures: + ! Catchment: tc1, tc2, tc4 (CSOIL also includes veg canopy) + ! CatchmentCN: tg1, tg2, tg4 (tc[X] are separate canopy temperatures) + + REAL, PARAMETER, PUBLIC :: CATCH_DZTSURF = 0.05 ! m layer depth for tc[X] or tg[X] ! --------------------------------------------------------------------------- ! @@ -172,7 +179,7 @@ subroutine echo_catch_constants(logunit) write (logunit,*) 'CATCH_SNWALB_SLOPE = ', CATCH_SNWALB_SLOPE write (logunit,*) 'CATCH_MAXSNDEPTH = ', CATCH_MAXSNDEPTH write (logunit,*) 'CATCH_DZ1MAX = ', CATCH_DZ1MAX - write (logunit,*) 'CATCH_DZTC = ', CATCH_DZTC + write (logunit,*) 'CATCH_DZTSURF = ', CATCH_DZTSURF write (logunit,*) 'CATCH_DZGT = ', CATCH_DZGT write (logunit,*) 'CATCH_PHIGT = ', CATCH_PHIGT write (logunit,*) 'CATCH_ALHMGT = ', CATCH_ALHMGT diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 18fe158ae..0bff37b07 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -31,7 +31,7 @@ MODULE lsm_routines N_SNOW => CATCH_N_SNOW, & N_GT => CATCH_N_GT, & RHOFS => CATCH_SNWALB_RHOFS, & - DZTC => CATCH_DZTC, & + DZTSURF => CATCH_DZTSURF, & DZGT => CATCH_DZGT, & PHIGT => CATCH_PHIGT, & FSN => CATCH_FSN, & @@ -907,7 +907,7 @@ subroutine gndtp0(t1,phi,zbar,thetaf,ht,fh21w,fh21i,fh21d, & ! calculate the boundaries, based on the layer thicknesses(DZGT) - zb(1)=-DZTC + zb(1)=-DZTSURF zb(2)=zb(1)-DZGT(1) shc(1)=shr0*(1.-phi)*DZGT(1) zc(1)=0.5*(zb(1)+zb(2)) @@ -992,7 +992,7 @@ subroutine gndtp0(t1,phi,zbar,thetaf,ht,fh21w,fh21i,fh21d, & xklh(1)=(tksat-tkdry)*xwi + tkdry xklhw=tksat - denom=-(DZTC*0.5)-zc(1) + denom=-(DZTSURF*0.5)-zc(1) fh21w=-xklhw *(t1(1)-TF-tp(1))/denom fh21i=-xklh(1)*(t1(2)-TF-tp(1))/denom fh21d=-xklh(1)*(t1(3)-TF-tp(1))/denom @@ -1830,8 +1830,8 @@ subroutine gndtmp(dts,phi,zbar,thetaf,fh21,ht,xfice,tp, FICE) ! calculate the boundaries, based on the layer thicknesses(DZGT) - zb(1)=-DZTC ! Bottom of surface layer, which is handled outside - ! this routine. + zb(1)=-DZTSURF ! Bottom of surface layer, which is handled outside + ! this routine. do l=1,N_GT zb(l+1)=zb(l)-DZGT(l) shc(l)=shr0*(1.-phi)*DZGT(l) From 30ef2dc910b3850ff56e0dcfbb28b4daf2f18291 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 2 Feb 2022 11:52:49 -0500 Subject: [PATCH 58/66] more cleanup (lsm_routines.F90, catch_constants.f90_) - added vectorized catch_calc_zbar() in prep of non-zero-diff change for consistency - added new PEATCLSM constants to subroutine echo_catch_constants() --- .../GEOS_CatchCNCLM40GridComp.F90 | 2 + .../GEOS_CatchCNCLM45GridComp.F90 | 2 + .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 2 + .../Shared/catch_constants.f90 | 63 ++++++++++--------- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 63 +++++++++++++------ 5 files changed, 82 insertions(+), 50 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index d19b62260..b2b703bce 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -7807,6 +7807,8 @@ subroutine Driver ( RC ) if(associated(FSWCHANGE)) FSWCHANGE = FSW_CHANGE if(associated(WATERTABLED)) then WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) + ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing + !WATERTABLED = MIN( catch_calc_zbar(BF1, BF2, CATDEF), CDCR2/(1.-WPWET)/POROS/1000.) endif if(associated(TPSN1OUT)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index 2404a104e..a4af2dc6e 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -8061,6 +8061,8 @@ subroutine Driver ( RC ) if(associated(FSWCHANGE)) FSWCHANGE = FSW_CHANGE if(associated(WATERTABLED)) then WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) + ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing + !WATERTABLED = MIN( catch_calc_zbar(BF1, BF2, CATDEF), CDCR2/(1.-WPWET)/POROS/1000.) endif if(associated(TPSN1OUT)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index 22b5e4788..e366cdc84 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -5647,6 +5647,8 @@ subroutine Driver ( RC ) if(associated(FSWCHANGE )) FSWCHANGE = FSW_CHANGE if(associated(WATERTABLED )) then WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) + ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing + !WATERTABLED = MIN( catch_calc_zbar(BF1, BF2, CATDEF), CDCR2/(1.-WPWET)/POROS/1000.) endif if(associated(TPSN1)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 index 59da08ac5..92d07809f 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/catch_constants.f90 @@ -168,39 +168,42 @@ subroutine echo_catch_constants(logunit) write (logunit,*) write (logunit,*) 'echo_catch_constants():' write (logunit,*) - write (logunit,*) 'CATCH_N_PFAFS = ', CATCH_N_PFAFS - write (logunit,*) 'CATCH_N_PFAFSROUTE = ', CATCH_N_PFAFSROUTE - write (logunit,*) 'CATCH_N_SNOW = ', CATCH_N_SNOW - write (logunit,*) 'CATCH_N_GT = ', CATCH_N_GT - write (logunit,*) 'CATCH_N_ZONES = ', CATCH_N_ZONES - write (logunit,*) 'CATCH_SNWALB_RHOFS = ', CATCH_SNWALB_RHOFS - write (logunit,*) 'CATCH_SNWALB_VISMAX = ', CATCH_SNWALB_VISMAX - write (logunit,*) 'CATCH_SNWALB_NIRMAX = ', CATCH_SNWALB_NIRMAX - write (logunit,*) 'CATCH_SNWALB_SLOPE = ', CATCH_SNWALB_SLOPE - write (logunit,*) 'CATCH_MAXSNDEPTH = ', CATCH_MAXSNDEPTH - write (logunit,*) 'CATCH_DZ1MAX = ', CATCH_DZ1MAX - write (logunit,*) 'CATCH_DZTSURF = ', CATCH_DZTSURF - write (logunit,*) 'CATCH_DZGT = ', CATCH_DZGT - write (logunit,*) 'CATCH_PHIGT = ', CATCH_PHIGT - write (logunit,*) 'CATCH_ALHMGT = ', CATCH_ALHMGT - write (logunit,*) 'CATCH_FSN = ', CATCH_FSN - write (logunit,*) 'CATCH_SHR = ', CATCH_SHR - write (logunit,*) 'CATCH_SCONST = ', CATCH_SCONST - write (logunit,*) 'CATCH_CSOIL_1 = ', CATCH_CSOIL_1 - write (logunit,*) 'CATCH_C_CANOP = ', CATCH_C_CANOP - write (logunit,*) 'CATCH_SATCAPFR = ', CATCH_SATCAPFR + write (logunit,*) 'CATCH_N_PFAFS = ', CATCH_N_PFAFS + write (logunit,*) 'CATCH_N_PFAFSROUTE = ', CATCH_N_PFAFSROUTE + write (logunit,*) 'CATCH_N_SNOW = ', CATCH_N_SNOW + write (logunit,*) 'CATCH_N_GT = ', CATCH_N_GT + write (logunit,*) 'CATCH_N_ZONES = ', CATCH_N_ZONES + write (logunit,*) 'CATCH_SNWALB_RHOFS = ', CATCH_SNWALB_RHOFS + write (logunit,*) 'CATCH_SNWALB_VISMAX = ', CATCH_SNWALB_VISMAX + write (logunit,*) 'CATCH_SNWALB_NIRMAX = ', CATCH_SNWALB_NIRMAX + write (logunit,*) 'CATCH_SNWALB_SLOPE = ', CATCH_SNWALB_SLOPE + write (logunit,*) 'CATCH_MAXSNDEPTH = ', CATCH_MAXSNDEPTH + write (logunit,*) 'CATCH_DZ1MAX = ', CATCH_DZ1MAX + write (logunit,*) 'CATCH_DZTSURF = ', CATCH_DZTSURF + write (logunit,*) 'CATCH_DZGT = ', CATCH_DZGT + write (logunit,*) 'CATCH_PHIGT = ', CATCH_PHIGT + write (logunit,*) 'CATCH_ALHMGT = ', CATCH_ALHMGT + write (logunit,*) 'CATCH_FSN = ', CATCH_FSN + write (logunit,*) 'CATCH_SHR = ', CATCH_SHR + write (logunit,*) 'CATCH_SCONST = ', CATCH_SCONST + write (logunit,*) 'CATCH_CSOIL_1 = ', CATCH_CSOIL_1 + write (logunit,*) 'CATCH_C_CANOP = ', CATCH_C_CANOP + write (logunit,*) 'CATCH_SATCAPFR = ', CATCH_SATCAPFR + write (logunit,*) + write (logunit,*) 'PEATCLSM_POROS_THRESHOLD = ', PEATCLSM_POROS_THRESHOLD + write (logunit,*) 'PEATCLSM_ZBARMAX_4_SYSOIL = ', PEATCLSM_ZBARMAX_4_SYSOIL write (logunit,*) write (logunit,*) 'Constants from SURFPARAMS:' write (logunit,*) - write (logunit,*) 'LAND_FIX = ', LAND_FIX - write (logunit,*) 'CSOIL_2 = ', CSOIL_2 - write (logunit,*) 'WEMIN = ', WEMIN - write (logunit,*) 'AICEV = ', AICEV - write (logunit,*) 'AICEN = ', AICEN - write (logunit,*) 'FLWALPHA = ', FLWALPHA - write (logunit,*) 'ASTRFR = ', ASTRFR - write (logunit,*) 'STEXP = ', STEXP - write (logunit,*) 'RSWILT = ', RSWILT + write (logunit,*) 'LAND_FIX = ', LAND_FIX + write (logunit,*) 'CSOIL_2 = ', CSOIL_2 + write (logunit,*) 'WEMIN = ', WEMIN + write (logunit,*) 'AICEV = ', AICEV + write (logunit,*) 'AICEN = ', AICEN + write (logunit,*) 'FLWALPHA = ', FLWALPHA + write (logunit,*) 'ASTRFR = ', ASTRFR + write (logunit,*) 'STEXP = ', STEXP + write (logunit,*) 'RSWILT = ', RSWILT write (logunit,*) write (logunit,*) 'end echo_catch_constants()' write (logunit,*) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 0bff37b07..74d962412 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -59,6 +59,11 @@ MODULE lsm_routines PUBLIC :: gndtmp, catch_calc_tp, catch_calc_wtotl, catch_calc_ght, catch_calc_FT PUBLIC :: dampen_tc_oscillations, irrigation_rate + INTERFACE catch_calc_zbar + MODULE PROCEDURE catch_calc_zbar_scalar + MODULE PROCEDURE catch_calc_zbar_vector + END INTERFACE catch_calc_zbar + ! --------------------------------------------------------------------------- ! ! ***** Do not define *public* Catchment model constants here. ***** @@ -1716,28 +1721,46 @@ subroutine catch_calc_soil_moist( & end subroutine catch_calc_soil_moist ! ******************************************************************* + + ! Calculate zbar for Catchment[CN] model. + ! + ! Convention: zbar positive below ground (downward). + ! + ! This convention applies to water calculations, incl. subroutines RZDRAIN(), + ! WUPDAT(), BASE(), PEATCLSM + ! + ! WARNING: + ! Opposite convention applies when zbar is used in ground heat + ! diffusion model, incl. subroutines GNDTP0(), GNDTMP(), GNDTMP_CN(). + ! + ! - reichle, 29 Jan 2022 + + function catch_calc_zbar_scalar( bf1, bf2, catdef ) result(zbar) + + implicit none + + real, intent(in) :: bf1, bf2, catdef + real :: zbar - real function catch_calc_zbar( bf1, bf2, catdef ) - - ! Calculate zbar for Catchment[CN] model. - ! - ! Convention: zbar positive below ground (downward). - ! - ! This convention applies to water calculations, incl. subroutines RZDRAIN(), - ! WUPDAT(), BASE(), PEATCLSM - ! - ! WARNING: - ! Opposite convention applies when zbar is used in ground heat - ! diffusion model, incl. subroutines GNDTP0(), GNDTMP(), GNDTMP_CN(). - ! - ! - reichle, 29 Jan 2022 - - real, intent(in) :: bf1, bf2, catdef - - catch_calc_zbar = SQRT(1.e-20 + catdef/bf1) - bf2 - - end function catch_calc_zbar + zbar = SQRT(1.e-20 + catdef/bf1) - bf2 + + end function catch_calc_zbar_scalar + + ! -------------------------- + + function catch_calc_zbar_vector( bf1, bf2, catdef ) result(zbar) + + ! vector version of catch_calc_zbar + implicit none + + real, dimension(:), intent(in) :: bf1, bf2, catdef + real, dimension(size(bf1)) :: zbar + + zbar = SQRT(1.e-20 + catdef/bf1) - bf2 + + end function catch_calc_zbar_vector + ! ******************************************************************* subroutine catch_calc_subtile2tile( NTILES, ar1, ar2, asnow, subtile_data, tile_data ) From 99f1dc9d4c00c48e39f26bec2893e9b910a6e6c4 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 2 Feb 2022 13:08:55 -0500 Subject: [PATCH 59/66] Bug fixes: missing ./DTSTEP in RUNSRF calc; PEATCLSM implementation in CatchCN. Changed CATDEF init in PEATCLSM (Scale_Catch[CN].F90). --- .../Shared/catchmentCN.F90 | 24 ++++++++++++++----- .../GEOScatch_GridComp/catchment.F90 | 7 +++--- .../Utils/mk_restarts/Scale_Catch.F90 | 2 +- .../Utils/mk_restarts/Scale_CatchCN.F90 | 2 +- 4 files changed, 24 insertions(+), 11 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 3f33af11f..0cef42ed9 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -1823,19 +1823,24 @@ SUBROUTINE RZDRAIN ( & ! (--> NOTE: PEATCLSM has no Hortonian runoff for zbar > 0) CATDEF_PEAT_THRESHOLD = ((BF2(N))**2.0-1.e-20)*BF1(N) IF(CATDEF(N) .LT. CATDEF_PEAT_THRESHOLD) THEN - RUNSRF(N)=RUNSRF(N) + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) + ! RUNSRF(N)=RUNSRF(N) + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) ! runoff from AR1 for zbar>0 - RZFLW_AR1 = RZFLW - RZFLW_CATDEF + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) + ! RZFLW_AR1 = RZFLW - RZFLW_CATDEF + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) ! AR1=0.5 at zbar=0 ! SYsurface=0.5 at zbar=0 - RUNSRF(N) = RUNSRF(N) + amax1(0.0, RZFLW_AR1 - 0.5*1000.*ZBAR1) - ! + ! RUNSRF(N) = RUNSRF(N) + amax1(0.0, RZFLW_AR1 - 0.5*1000.*ZBAR1) + ! + ! revised (rdk, 1/04/2021): take excess water from both + ! soil and free standing water, the latter assumed to cover area AR1=0.5 + RUNSRF(N) = RUNSRF(N) + (CATDEF_PEAT_THRESHOLD-CATDEF(N) + 0.5*1000.*(-ZBAR1))/DTSTEP CATDEF(N)=CATDEF_PEAT_THRESHOLD ENDIF ENDIF IF(CATDEF(N) .LT. 0.) THEN - RUNSRF(N)=RUNSRF(N)-CATDEF(N) + ! Bug fix: Added missing division by DTSTEP; short test runs suggest that if block + ! is rarely if ever reached, so effectively 0-diff; reichle+rdkoster, 2/2/22 + RUNSRF(N)=RUNSRF(N)-CATDEF(N)/DTSTEP CATDEF(N)=0. ENDIF @@ -2622,7 +2627,14 @@ subroutine gndtmp_cn(poros, zbar, ht, xfice, tp, FICE) do l=lstart,N_GT xfice=xfice+fice(l) enddo - xfice=xfice/((N_GT+1)-lstart) + + IF (phi < PEATCLSM_POROS_THRESHOLD) THEN + xfice=xfice/((N_GT+1)-lstart) + ELSE + !PEAT + !MB: only first layer for total runoff reduction + xfice=AMIN1(1.0,fice(1)) + ENDIF Return end subroutine gndtmp_cn diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 040f0a327..223aa7173 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -1856,14 +1856,15 @@ SUBROUTINE RZDRAIN ( & ! ! revised (rdk, 1/04/2021): take excess water from both ! soil and free standing water, the latter assumed to cover area AR1=0.5 - RUNSRF(N) = RUNSRF(N) + CATDEF_PEAT_THRESHOLD-CATDEF(N) + 0.5*1000.*(-ZBAR1) - + RUNSRF(N) = RUNSRF(N) + (CATDEF_PEAT_THRESHOLD-CATDEF(N) + 0.5*1000.*(-ZBAR1))/DTSTEP CATDEF(N)=CATDEF_PEAT_THRESHOLD ENDIF ENDIF IF(CATDEF(N) .LT. 0.) THEN - RUNSRF(N)=RUNSRF(N)-CATDEF(N) + ! Bug fix: Added missing division by DTSTEP; short test runs suggest that if block + ! is rarely if ever reached, so effectively 0-diff; reichle+rdkoster, 2/2/22 + RUNSRF(N)=RUNSRF(N)-CATDEF(N)/DTSTEP CATDEF(N)=0. ENDIF diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index 4b5755d5f..53c785a3d 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -367,7 +367,7 @@ program Scale_Catch ! ------------------------------------------- where (catch(sca)%poros >= PEATCLSM_POROS_THRESHOLD) - catch(sca)%catdef = 100. + catch(sca)%catdef = 25. ! changed from 100. to 25. for now, needs more thought, reichle, 2/2/22 catch(sca)%rzexc = 0. catch(sca)%srfexc = 0. end where diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index a0d15b42f..84c5d9af7 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -406,7 +406,7 @@ program Scale_CatchCN ! ------------------------------------------- where (catch(sca)%poros >= PEATCLSM_POROS_THRESHOLD) - catch(sca)%catdef = 100. + catch(sca)%catdef = 25. ! changed to 25. for now, needs more thought, reichle, 2/2/22 catch(sca)%rzexc = 0. catch(sca)%srfexc = 0. end where From 666d16073d7d6bc041a88940ee3ba7e05fe5f955 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 2 Feb 2022 13:43:14 -0500 Subject: [PATCH 60/66] Bug fix: PEATCLSM implementation in CatchCN (added missing SWSRF4=WPWET) --- .../GEOScatchCN_GridComp/Shared/catchmentCN.F90 | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 0cef42ed9..4de80bb0a 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -737,9 +737,7 @@ SUBROUTINE CATCHCN ( & ENDDO - !**** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !**** 1. SATURATED FRACTION DO N=1,NCH @@ -758,9 +756,7 @@ SUBROUTINE CATCHCN ( & SHFLUX1, HLWUP1, GHFLUX1 & ) - !**** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !**** 2. SUBSATURATED BUT UNSTRESSED FRACTION CALL RSURFP2 ( NCH, RSSAT, SWSRF2, QSAT2, QA2, PSUR, WPWET, RSURF ) @@ -772,20 +768,19 @@ SUBROUTINE CATCHCN ( & SWNETF, HLWDWN, ALW2, BLW2, & QM, CSOIL, CCANOP, PSUR, & HFTDS2, DHFT2, RD, RSURF, POTFRC, & - TG2SF, TC2SF, QA2, & + TG2SF, TC2SF, QA2, & EVAP2, EVROOT2, EVSURF2, EVINT2, & SHFLUX2, HLWUP2, GHFLUX2 & ) -!**** - !**** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - !**** 3. WILTING FRACTION + ! MB: For ET calculation, AR4 surface wetness is set to WPWET + WHERE (POROS > PEATCLSM_POROS_THRESHOLD) SWSRF4 = WPWET ! PEATCLSM + CALL RSURFP2 ( NCH, RSSAT, SWSRF4, QSAT4, QA4, PSUR, WPWET, RSURF ) - CALL FLUXES ( & NCH, FVEG, DTSTEP, QSAT4, DQS4, & ETURB4, DEDQA4X, DEDTC4X, HSTURB4, DHSDQA4X, DHSDTC4X, & @@ -793,12 +788,11 @@ SUBROUTINE CATCHCN ( & SWNETF, HLWDWN, ALW4, BLW4, & QM, CSOIL, CCANOP, PSUR, & HFTDS4, DHFT4, RD, RSURF, POTFRC, & - TG4SF, TC4SF, QA4, & + TG4SF, TC4SF, QA4, & EVAP4, EVROOT4, EVSURF4, EVINT4, & SHFLUX4, HLWUP4, GHFLUX4 & ) - !**** -------------------------------------------------------- !**** B. SNOW-COVERED FRACTION. From 24b04a3cfaf3075de585c65ed83151190e20d948 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 2 Feb 2022 20:33:23 -0500 Subject: [PATCH 61/66] fixed bug in implementation of catch_calc_zbar() --- .../GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index 223aa7173..bd750cb17 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -692,7 +692,8 @@ SUBROUTINE CATCHMENT ( & ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTP0) ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) else - ZBAR=-SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) + ! zbar minus sign applied in call to GNDTP0 + ZBAR = SQRT(1.e-20+catdef(n)/bf1(n))+bf2(n) ! old bug is wrong sign for bf2 here end if THETAF=.5 @@ -1065,7 +1066,8 @@ SUBROUTINE CATCHMENT ( & ! zbar function - reichle, 29 Jan 2022 (minus sign applied in call to GNDTMP) ZBAR = catch_calc_zbar( bf1(n), bf2(n), catdef(n) ) else - ZBAR=-SQRT(1.e-20+catdef(n)/bf1(n))-bf2(n) + ! zbar minus sign applied in call to GNDTMP + ZBAR = SQRT(1.e-20+catdef(n)/bf1(n))+bf2(n) ! old bug is wrong sign for bf2 here end if THETAF=.5 DO LAYER=1,6 From 4998436125e5ea1ef606d42307f12a349b9eca48 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 2 Feb 2022 21:06:09 -0500 Subject: [PATCH 62/66] added function catch_calc_watertabled() --- .../GEOS_CatchCNCLM40GridComp.F90 | 5 +++-- .../GEOS_CatchCNCLM45GridComp.F90 | 5 +++-- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 4 ++-- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 18 +++++++++++++++++- 4 files changed, 25 insertions(+), 7 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index b2b703bce..10cf1d972 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -61,7 +61,8 @@ module GEOS_CatchCNCLM40GridCompMod use MAPL_ConstantsMod,only: Tzero => MAPL_TICE, pi => MAPL_PI use clm_time_manager, only: get_days_per_year, get_step_size use pftvarcon, only: noveg - USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, catch_calc_zbar, irrigation_rate + USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & + catch_calc_zbar, catch_calc_watertabled, irrigation_rate implicit none private @@ -7808,7 +7809,7 @@ subroutine Driver ( RC ) if(associated(WATERTABLED)) then WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing - !WATERTABLED = MIN( catch_calc_zbar(BF1, BF2, CATDEF), CDCR2/(1.-WPWET)/POROS/1000.) + !WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) endif if(associated(TPSN1OUT)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index a4af2dc6e..bc2e54bcf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -61,7 +61,8 @@ module GEOS_CatchCNCLM45GridCompMod use MAPL_ConstantsMod,only: Tzero => MAPL_TICE, pi => MAPL_PI use clm_time_manager, only: get_days_per_year, get_step_size use pftvarcon, only: noveg - USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, catch_calc_zbar, irrigation_rate + USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, & + catch_calc_zbar, catch_calc_watertabled, irrigation_rate use update_model_para4cn, only : upd_curr_date_time implicit none @@ -8062,7 +8063,7 @@ subroutine Driver ( RC ) if(associated(WATERTABLED)) then WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing - !WATERTABLED = MIN( catch_calc_zbar(BF1, BF2, CATDEF), CDCR2/(1.-WPWET)/POROS/1000.) + !WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) endif if(associated(TPSN1OUT)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index e366cdc84..dd3b79ca6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -45,7 +45,7 @@ module GEOS_CatchGridCompMod SNWALB_NIRMAX => CATCH_SNWALB_NIRMAX, & SLOPE => CATCH_SNWALB_SLOPE - USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist + USE lsm_routines, ONLY : sibalb, catch_calc_soil_moist, catch_calc_watertabled !#for_ldas_coupling use catch_incr @@ -5648,7 +5648,7 @@ subroutine Driver ( RC ) if(associated(WATERTABLED )) then WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing - !WATERTABLED = MIN( catch_calc_zbar(BF1, BF2, CATDEF), CDCR2/(1.-WPWET)/POROS/1000.) + !WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) endif if(associated(TPSN1)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 74d962412..f794a7338 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -55,7 +55,8 @@ MODULE lsm_routines PRIVATE PUBLIC :: INTERC, SRUNOFF, BASE, PARTITION, RZEQUIL, gndtp0 - PUBLIC :: SIBALB, catch_calc_soil_moist, catch_calc_zbar, catch_calc_subtile2tile + PUBLIC :: SIBALB, catch_calc_soil_moist, catch_calc_zbar, catch_calc_watertabled + PUBLIC :: catch_calc_subtile2tile PUBLIC :: gndtmp, catch_calc_tp, catch_calc_wtotl, catch_calc_ght, catch_calc_FT PUBLIC :: dampen_tc_oscillations, irrigation_rate @@ -1763,6 +1764,21 @@ end function catch_calc_zbar_vector ! ******************************************************************* + function catch_calc_watertabled( bf1, bf2, cdcr2, poros, wpwet, catdef ) result(wtd) + + ! calculate water table depth [m] + + implicit none + + real, dimension(:), intent(in) :: bf1, bf2, cdcr2, poros, wpwet, catdef + real, dimension(size(bf1)) :: wtd + + wtd = MIN( catch_calc_zbar(BF1,BF2,CATDEF), CDCR2/(1.-WPWET)/POROS/1000. ) + + end function catch_calc_watertabled + + ! ******************************************************************* + subroutine catch_calc_subtile2tile( NTILES, ar1, ar2, asnow, subtile_data, tile_data ) ! average from subtile space to tile-average From 3c4ee1b2fd9b86b2c0701a2cdee869d917c7e298 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 8 Feb 2022 13:31:59 -0500 Subject: [PATCH 63/66] further clarification of throughfall (THRU[x]) units; fixed typo (build error) in previous commit --- .../Shared/catchmentCN.F90 | 7 ++--- .../GEOScatch_GridComp/catchment.F90 | 8 +++--- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 27 ++++++++++--------- 3 files changed, 24 insertions(+), 18 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 index 4f5c5bddb..73619d98d 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/Shared/catchmentCN.F90 @@ -259,7 +259,7 @@ SUBROUTINE CATCHCN ( & RC, SATCAP, SNWFRC, POTFRC, ESNFRC, EVSNOW, SHFLUXS, HLWUPS, & HFTDS1, HFTDS2, HFTDS4, DHFT1, DHFT2, DHFT4, TPSNB, & QSATTC, DQSDTC, SWSRF1, SWSRF2, SWSRF4, AR4, & - FCAN, THRUL, THRUC, RZEQOL, frice, srfmx, & + FCAN, THRUL_VOL, THRUC_VOL, RZEQOL, frice, srfmx, & srfmn, RCST1, RCST2, EVAPFR, RDCX, EVAP1, EVAP2, & EVAP4, SHFLUX1, SHFLUX2, SHFLUX4, HLWUP1, HLWUP2, HLWUP4, & GHFLUX1, GHFLUX2, GHFLUX4, RZI, TC1SF, TC2SF, TC4SF, ar1old, & @@ -1154,7 +1154,7 @@ SUBROUTINE CATCHCN ( & NCH, DTSTEP, FWETC, FWETL, TRAINLX, TRAINCX, SMELT, & SATCAP, BUG, & CAPAC, & - THRUL, THRUC & + THRUL_VOL, THRUC_VOL & ) IF (BUG) THEN @@ -1164,7 +1164,8 @@ SUBROUTINE CATCHCN ( & !**** DETERMINE SURFACE RUNOFF AND INFILTRATION RATES: CALL SRUNOFF ( NCH, DTSTEP, UFW4RO, FWETC, FWETL, & - AR1, AR2, AR4, THRUL, THRUC, FRICE, TP1, SRFMX, BUG, & + AR1, AR2, AR4, THRUL_VOL, THRUC_VOL, & + FRICE, TP1, SRFMX, BUG, & VGWMAX, RZEQOL, POROS, & SRFEXC, RZEXC, RUNSRF, & QINFIL & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 index d1b3788db..5e0c1c8e7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/catchment.F90 @@ -246,7 +246,8 @@ SUBROUTINE CATCHMENT ( & RC, SATCAP, SNWFRC, POTFRC, ESNFRC, EVSNOW, SHFLUXS, HLWUPS, & HFTDS1, HFTDS2, HFTDS4, DHFT1, DHFT2, DHFT4, TPSNB, & QSATTC, DQSDTC, SWSRF1, SWSRF2, SWSRF4, AR4, RX11, RX21, RX12, & - RX14, RX24, RX22, EIRFRC, FCAN, THRUL, THRUC,RZEQOL, frice, srfmx, & + RX14, RX24, RX22, EIRFRC, FCAN, THRUL_VOL, THRUC_VOL, & + RZEQOL, frice, srfmx, & srfmn, RCST, EVAPFR, RCUN, PAR, PDIR, RDCX, EVAP1, EVAP2, & EVAP4, SHFLUX1, SHFLUX2, SHFLUX4, HLWUP1, HLWUP2, HLWUP4, & GHFLUX1, GHFLUX2, GHFLUX4, RZI, TC1SF, TC2SF, TC4SF, ar1old, & @@ -1170,7 +1171,7 @@ SUBROUTINE CATCHMENT ( & NCH, DTSTEP, FWETC, FWETL, TRAINLX, TRAINCX, SMELT, & SATCAP, BUG, & CAPAC, & - THRUL, THRUC & + THRUL_VOL, THRUC_VOL & ) IF (BUG) THEN @@ -1180,7 +1181,8 @@ SUBROUTINE CATCHMENT ( & !**** DETERMINE SURFACE RUNOFF AND INFILTRATION RATES: CALL SRUNOFF ( NCH, DTSTEP, UFW4RO, FWETC, FWETL, & - AR1, AR2, AR4, THRUL, THRUC, FRICE, TP1, SRFMX, BUG, & + AR1, AR2, AR4, THRUL_VOL, THRUC_VOL, & + FRICE, TP1, SRFMX, BUG, & VGWMAX, RZEQOL, POROS, & SRFEXC, RZEXC, RUNSRF, & QINFIL & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index cd9c0454f..0a094acd3 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -102,7 +102,7 @@ SUBROUTINE INTERC ( & TRAINL, TRAINC, SMELT, & ! [kg m-2 s-1] SATCAP,BUG, & CAPAC, & - THRUL, THRUC & ! [kg m-2] !!!! + THRUL_VOL, THRUC_VOL & ! [kg m-2] !!!! ) !**** !**** THIS ROUTINE USES THE PRECIPITATION FORCING TO DETERMINE @@ -124,10 +124,12 @@ SUBROUTINE INTERC ( & REAL, INTENT(INOUT), DIMENSION(NCH) :: CAPAC - REAL, INTENT(OUT), DIMENSION(NCH) :: THRUC, THRUL ! [kg m-2] ("volume" units) !!! - - INTEGER CHNO - REAL WETINT, WATADD, CAVAIL, THRU1, THRU2, XTCORR,SMPERS + REAL, INTENT(OUT), DIMENSION(NCH) :: THRUL_VOL, THRUC_VOL ! [kg m-2] ("volume" units) !!! + + ! -------------------------- + + INTEGER :: CHNO + REAL :: WETINT, WATADD, CAVAIL, THRU1, THRU2, XTCORR, SMPERS, THRUL, THRUC !**** !**** ------------------------------------------------------------------ @@ -169,7 +171,7 @@ SUBROUTINE INTERC ( & THRU2=XTCORR*WATADD - THRUL(CHNO)=THRU1+THRU2 + THRUL=THRU1+THRU2 CAPAC(CHNO)=CAPAC(CHNO)+WATADD-THRU1-THRU2 @@ -206,13 +208,14 @@ SUBROUTINE INTERC ( & THRU2=XTCORR*WATADD - THRUC(CHNO)=THRU1+THRU2 + THRUC=THRU1+THRU2 + CAPAC(CHNO)=CAPAC(CHNO)+WATADD-THRU1-THRU2 !**** - IF (THRUL(CHNO)+THRUC(CHNO) .LT. -1.e-8) WRITE(*,*) 'THRU= ', & - THRUL(CHNO), THRUC(CHNO), TRAINC(CHNO), TRAINL(CHNO), SMELT(CHNO) - THRUL(CHNO)=AMAX1(0., THRUL(CHNO)) - THRUC(CHNO)=AMAX1(0., THRUC(CHNO)) + IF (THRUL+THRUC .LT. -1.e-8) WRITE(*,*) 'THRU= ', & + THRUL, THRUC, TRAINC(CHNO), TRAINL(CHNO), SMELT(CHNO) + THRUL_VOL(CHNO)=AMAX1(0., THRUL) + THRUC_VOL(CHNO)=AMAX1(0., THRUC) 100 CONTINUE !**** @@ -466,7 +469,7 @@ SUBROUTINE RZDRAIN ( & NCH, DTSTEP, VGWMAX, SATCAP, RZEQ, AR1, WPWET, & TSA1, TSA2, TSB1, TSB2, ATAU, BTAU, CDCR2, POROS, & BF1, BF2, ARS1, ARS2, ARS3, BUG, & - CAPAC, RZEXC, SRFEXC,C ATDEF, & + CAPAC, RZEXC, SRFEXC, CATDEF, & RUNSRF & ! [kg m-2 s-1] ) From 9dcb6820f61d8eed540a5b508b557b90b3cfaef2 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 8 Feb 2022 18:37:34 -0500 Subject: [PATCH 64/66] additional cleanup: assorted roundoff (non-zero-diff) changes in PEATCLSM : - enable use of vectorized catch_calc_zbar() to compute WATERTABLED export - remove unnecessary -1.e-20 in rzdrain() - simplify ramp function implementation for surface runoff as fn of ar1 --- .../GEOS_CatchCNCLM40GridComp.F90 | 4 +--- .../GEOS_CatchCNCLM45GridComp.F90 | 4 +--- .../GEOScatch_GridComp/GEOS_CatchGridComp.F90 | 4 +--- .../GEOSland_GridComp/Shared/lsm_routines.F90 | 12 ++++++------ 4 files changed, 9 insertions(+), 15 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 index 10cf1d972..94f678389 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM40_GridComp/GEOS_CatchCNCLM40GridComp.F90 @@ -7807,9 +7807,7 @@ subroutine Driver ( RC ) if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) if(associated(FSWCHANGE)) FSWCHANGE = FSW_CHANGE if(associated(WATERTABLED)) then - WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) - ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing - !WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) + WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) endif if(associated(TPSN1OUT)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 index bc2e54bcf..6e957989a 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatchCN_GridComp/GEOScatchCNCLM45_GridComp/GEOS_CatchCNCLM45GridComp.F90 @@ -8061,9 +8061,7 @@ subroutine Driver ( RC ) if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) if(associated(FSWCHANGE)) FSWCHANGE = FSW_CHANGE if(associated(WATERTABLED)) then - WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) - ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing - !WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) + WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) endif if(associated(TPSN1OUT)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 index dd3b79ca6..ebb728495 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOScatch_GridComp/GEOS_CatchGridComp.F90 @@ -5646,9 +5646,7 @@ subroutine Driver ( RC ) if(associated(RMELTOC002)) RMELTOC002 = RMELT(:,9) if(associated(FSWCHANGE )) FSWCHANGE = FSW_CHANGE if(associated(WATERTABLED )) then - WATERTABLED = MIN(SQRT(1.e-15 + CATDEF/BF1) - BF2, CDCR2/(1.-WPWET)/POROS/1000.) - ! non-zero-diff change for PEATCLSM, to be implemented after final PEATCLSM 0-diff testing - !WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) + WATERTABLED = catch_calc_watertabled( BF1, BF2, CDCR2, POROS, WPWET, CATDEF ) endif if(associated(TPSN1)) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 index 0a094acd3..fa6f2d6d5 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/Shared/lsm_routines.F90 @@ -267,8 +267,8 @@ SUBROUTINE SRUNOFF ( & ! constants for PEATCLSM piecewise linear relationship between surface runoff and AR1 - REAL, PARAMETER :: SRUN_AR1_MIN = 0.5 - REAL, PARAMETER :: SRUN_AR1_INVSLOPE = 0.1 + REAL, PARAMETER :: SRUN_AR1_MIN = 0.5 + REAL, PARAMETER :: SRUN_AR1_SLOPE = 10. !**** - - - - - - - - - - - - - - - - - - - - - - - - - @@ -319,7 +319,7 @@ SUBROUTINE SRUNOFF ( & ! handling numerical instability due to exceptional snow melt events at some pixels ! avoid AR1 to increase much higher than > 0.5 by enabling runoff !Added ramping to avoid potential oscillations (rdk, 09/18/20) - IF (AR1(N)>SRUN_AR1_MIN) srun0=PTOTAL*amin1(1.,(ar1(n)-SRUN_AR1_MIN)/SRUN_AR1_INVSLOPE) + IF (AR1(N)>SRUN_AR1_MIN) srun0=PTOTAL*amin1(1.,(ar1(n)-SRUN_AR1_MIN)*SRUN_AR1_SLOPE) ! MB: even no surface runoff when srfmx is exceeded (activating macro-pore flow) ! Rewrote code to determine excess over capacity all at once (rdk, 09/18/20) @@ -411,8 +411,8 @@ SUBROUTINE SRUNOFF ( & ! avoid AR1 to increase much higher than > 0.5 by enabling runoff IF (AR1(N)>SRUN_AR1_MIN) THEN !Added ramping to avoid potential oscillations (rdk, 09/18/20) - srunl = THRUL(n)*amin1(1.,(ar1(n)-SRUN_AR1_MIN)/SRUN_AR1_INVSLOPE) - srunc = THRUC(n)*amin1(1.,(ar1(n)-SRUN_AR1_MIN)/SRUN_AR1_INVSLOPE) + srunl = THRUL(n)*amin1(1.,(ar1(n)-SRUN_AR1_MIN)*SRUN_AR1_SLOPE) + srunc = THRUC(n)*amin1(1.,(ar1(n)-SRUN_AR1_MIN)*SRUN_AR1_SLOPE) ENDIF PTOTAL = THRUL(N) + THRUC(N) SRUN0 = srunl + srunc @@ -638,7 +638,7 @@ SUBROUTINE RZDRAIN ( & ! zbar<0 only occurred due to extreme infiltration rates ! (noticed this only snow melt events, very few locations and times) ! (--> NOTE: PEATCLSM has no Hortonian runoff for zbar > 0) - CATDEF_PEAT_THRESHOLD = ((BF2(N))**2.0-1.e-20)*BF1(N) + CATDEF_PEAT_THRESHOLD = ((BF2(N))**2.0)*BF1(N) IF(CATDEF(N) .LT. CATDEF_PEAT_THRESHOLD) THEN ! RUNSRF(N)=RUNSRF(N) + (CATDEF_PEAT_THRESHOLD - CATDEF(N)) ! runoff from AR1 for zbar>0 From 19b87d7c12fdf96258c07863bed6b116fc5f233f Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 9 Feb 2022 20:32:48 -0500 Subject: [PATCH 65/66] commented out presumably obsolete subroutine process_peatmap() in mod_process_hres_data.F90 --- .../Utils/Raster/mod_process_hres_data.F90 | 168 +++++++++--------- 1 file changed, 85 insertions(+), 83 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 index 74e8c80c0..cc9b37ebf 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 @@ -3758,7 +3758,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) logical :: regrid,write_file INTEGER, allocatable, dimension (:) :: soil_class_top,soil_class_com REAL :: sf,factor,wp_wetness,fac_count - logical :: file_exists + logical :: CatchParamsNC_file_exists REAL, ALLOCATABLE, DIMENSION (:,:) :: parms4file ! PEAT-clsm modification ! Below parameters are from Table 2 of: @@ -4604,9 +4604,9 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) ! call process_peatmap (nx, ny, gfiler, pmap) - inquire(file='clsm/catch_params.nc4', exist=file_exists) + inquire(file='clsm/catch_params.nc4', exist=CatchParamsNC_file_exists) - if(file_exists) then + if(CatchParamsNC_file_exists) then status = NF_OPEN ('clsm/catch_params.nc4', NF_WRITE, ncid) ; VERIFY_(STATUS) allocate (parms4file (1:maxcat, 1:10)) endif @@ -4699,8 +4699,8 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) endif end do write (11,'(a)')' ' - write (11,'(a)')'FMT=i10,i8,i4,i4,3f8.4,f12.8,f7.4,f10.4,3f7.3,4f7.3,2f10.4' - write (11,'(a)')'TileIndex PfafID SoilClassTop SoilClassProfile BEE PSIS POROS Ks_at_SURF WPWET SoilDepth %Grav %OCTop %OCProf %Sand_top %Clay_top %Sand_prof %Clay_prof WPWET_SURF POROS_SURF' + write (11,'(a)')'FMT=i10,i8,i4,i4,3f8.4,f12.8,f7.4,f10.4,3f7.3,4f7.3,2f10.4,f8.4' + write (11,'(a)')'TileIndex PfafID SoilClassTop SoilClassProfile BEE PSIS POROS Ks_at_SURF WPWET SoilDepth %Grav %OCTop %OCProf %Sand_top %Clay_top %Sand_prof %Clay_prof WPWET_SURF POROS_SURF PMAP' close (10, status = 'keep') close (11, status = 'keep') close (12, status = 'keep') @@ -4713,7 +4713,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) atau_2cm,btau_2cm) deallocate (soildepth, grav_vec,soc_vec,poc_vec,& ncells_top,ncells_top_pro,ncells_sub_pro,soil_class_top,soil_class_com) - if(file_exists) then + if(CatchParamsNC_file_exists) then status = NF_PUT_VARA_REAL(NCID,NC_VarID(NCID,'BEE' ) ,(/1/),(/maxcat/), parms4file (:, 1)) ; VERIFY_(STATUS) status = NF_PUT_VARA_REAL(NCID,NC_VarID(NCID,'COND' ) ,(/1/),(/maxcat/), parms4file (:, 2)) ; VERIFY_(STATUS) status = NF_PUT_VARA_REAL(NCID,NC_VarID(NCID,'POROS') ,(/1/),(/maxcat/), parms4file (:, 3)) ; VERIFY_(STATUS) @@ -4852,82 +4852,84 @@ END FUNCTION center_pix_int0 ! -------------------------------------------------------------------------------------- - SUBROUTINE process_peatmap (nc, nr, gfiler, pmap) - - implicit none - integer , parameter :: N_lon_pm = 43200, N_lat_pm = 21600 - integer, intent (in) :: nc, nr - real, pointer, dimension (:), intent (inout) :: pmap - character(*), intent (in) :: gfiler - integer :: i,j, status, varid, ncid - integer :: NTILES - REAL, ALLOCATABLE, dimension (:) :: count_pix - REAL, ALLOCATABLE, dimension (:,:) :: data_grid, pm_grid - INTEGER, ALLOCATABLE, dimension (:,:) :: tile_id - character*100 :: fout - - ! Reading number of tiles - ! ----------------------- - - open (20, file = 'clsm/catchment.def', form = 'formatted', status = 'old', action = 'read') - - read (20, *) NTILES - - close (20, status = 'keep') - - ! READ PEATMAP source data files and regrid - ! ----------------------------------------- - - status = NF_OPEN ('data/CATCH/PEATMAP_mask.nc4', NF_NOWRITE, ncid) - - allocate (pm_grid (1 : NC , 1 : NR)) - allocate (data_grid (1 : N_lon_pm, 1 : N_lat_pm)) - - status = NF_INQ_VARID (ncid,'PEATMAP',VarID) ; VERIFY_(STATUS) - status = NF_GET_VARA_REAL (ncid,VarID, (/1,1/),(/N_lon_pm, N_lat_pm/), data_grid) ; VERIFY_(STATUS) - - call RegridRasterReal(data_grid, pm_grid) - - status = NF_CLOSE(ncid) - - ! Grid to tile - ! ------------ - - ! Reading tile-id raster file - - allocate(tile_id(1:nc,1:nr)) - - open (10,file=trim(gfiler)//'.rst',status='old',action='read', & - form='unformatted',convert='little_endian') - - do j=1,nr - read(10)tile_id(:,j) - end do - - close (10,status='keep') - - allocate (pmap (1:NTILES)) - allocate (count_pix (1:NTILES)) - - pmap = 0. - count_pix = 0. - - do j = 1,nr - do i = 1, nc - if((tile_id(i,j).gt.0).and.(tile_id(i,j).le.NTILES)) then - if(pm_grid(i,j) > 0.) pmap (tile_id(i,j)) = pmap (tile_id(i,j)) + pm_grid(i,j) - count_pix (tile_id(i,j)) = count_pix (tile_id(i,j)) + 1. - endif - end do - end do - - where (count_pix > 0.) pmap = pmap/count_pix - - deallocate (count_pix) - deallocate (pm_grid) - deallocate (tile_id) - - END SUBROUTINE process_peatmap +! this subroutine seems obsolete, commented out for now - reichle, 9 Feb 2022 + +! SUBROUTINE process_peatmap (nc, nr, gfiler, pmap) +! +! implicit none +! integer , parameter :: N_lon_pm = 43200, N_lat_pm = 21600 +! integer, intent (in) :: nc, nr +! real, pointer, dimension (:), intent (inout) :: pmap +! character(*), intent (in) :: gfiler +! integer :: i,j, status, varid, ncid +! integer :: NTILES +! REAL, ALLOCATABLE, dimension (:) :: count_pix +! REAL, ALLOCATABLE, dimension (:,:) :: data_grid, pm_grid +! INTEGER, ALLOCATABLE, dimension (:,:) :: tile_id +! character*100 :: fout +! +! ! Reading number of tiles +! ! ----------------------- +! +! open (20, file = 'clsm/catchment.def', form = 'formatted', status = 'old', action = 'read') +! +! read (20, *) NTILES +! +! close (20, status = 'keep') +! +! ! READ PEATMAP source data files and regrid +! ! ----------------------------------------- +! +! status = NF_OPEN ('data/CATCH/PEATMAP_mask.nc4', NF_NOWRITE, ncid) +! +! allocate (pm_grid (1 : NC , 1 : NR)) +! allocate (data_grid (1 : N_lon_pm, 1 : N_lat_pm)) +! +! status = NF_INQ_VARID (ncid,'PEATMAP',VarID) ; VERIFY_(STATUS) +! status = NF_GET_VARA_REAL (ncid,VarID, (/1,1/),(/N_lon_pm, N_lat_pm/), data_grid) ; VERIFY_(STATUS) +! +! call RegridRasterReal(data_grid, pm_grid) +! +! status = NF_CLOSE(ncid) +! +! ! Grid to tile +! ! ------------ +! +! ! Reading tile-id raster file +! +! allocate(tile_id(1:nc,1:nr)) +! +! open (10,file=trim(gfiler)//'.rst',status='old',action='read', & +! form='unformatted',convert='little_endian') +! +! do j=1,nr +! read(10)tile_id(:,j) +! end do +! +! close (10,status='keep') +! +! allocate (pmap (1:NTILES)) +! allocate (count_pix (1:NTILES)) +! +! pmap = 0. +! count_pix = 0. +! +! do j = 1,nr +! do i = 1, nc +! if((tile_id(i,j).gt.0).and.(tile_id(i,j).le.NTILES)) then +! if(pm_grid(i,j) > 0.) pmap (tile_id(i,j)) = pmap (tile_id(i,j)) + pm_grid(i,j) +! count_pix (tile_id(i,j)) = count_pix (tile_id(i,j)) + 1. +! endif +! end do +! end do +! +! where (count_pix > 0.) pmap = pmap/count_pix +! +! deallocate (count_pix) +! deallocate (pm_grid) +! deallocate (tile_id) +! +! END SUBROUTINE process_peatmap ! ==================================================================== @@ -6398,7 +6400,7 @@ SUBROUTINE map_country_codes (NC, NR, gfiler) read (20, *) maxcat - ! READ PEATMAP source data files and regrid + ! READ country code source data files and regrid ! ----------------------------------------- status = NF_OPEN ('data/CATCH/GADM_Country_and_USStates_codes_1km.nc4', NF_NOWRITE, ncid) From 90f743995171c7039b680df24ea385f8618b76f1 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 10 Feb 2022 21:34:14 -0500 Subject: [PATCH 66/66] fixes in restart processing; cleanup: - in Scale_Catch[CN].F90, avoid resetting catdef etc for peat tiles that are also peat in source (old) restart - renamed "process_peat" to "use_PEATMAP" for clarity --- .../Utils/Raster/mkCatchParam.F90 | 2 +- .../Utils/Raster/mod_process_hres_data.F90 | 10 ++--- .../Utils/Raster/rmTinyCatchParaMod.F90 | 38 +++++++++---------- .../Utils/mk_restarts/Scale_Catch.F90 | 12 +++--- .../Utils/mk_restarts/Scale_CatchCN.F90 | 12 +++--- 5 files changed, 37 insertions(+), 37 deletions(-) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 index 2675f127d..3d25d1671 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mkCatchParam.F90 @@ -185,7 +185,7 @@ PROGRAM mkCatchParam GridnameT='til/'//trim(Gridname) endif - if(process_peat) PEATSOURCE = 'PEATMAP' + if(use_PEATMAP) PEATSOURCE = 'PEATMAP' if(jpl_height) VEGZSOURCE = 'JPL' if(n_threads == 1) then diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 index cc9b37ebf..5c776d1f0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/mod_process_hres_data.F90 @@ -4036,7 +4036,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) end do end do - if(process_peat) then + if(use_PEATMAP) then print *, 'PMAP_THRESH : ', pmap_thresh allocate(pmapr (1:i_highd,1:j_highd)) status = NF_OPEN ('data/CATCH/PEATMAP_mask.nc4', NF_NOWRITE, ncid) @@ -4274,7 +4274,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) allocate(btau_2cm(1:n_SoilClasses)) allocate(a_wpsurf(1:n_SoilClasses)) allocate(a_porosurf(1:n_SoilClasses)) - if(process_peat) then + if(use_PEATMAP) then fname = trim(c_data)//'SoilClasses-SoilHyd-TauParam.peatmap' else fname = trim(c_data)//'SoilClasses-SoilHyd-TauParam.dat' @@ -4375,7 +4375,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) !$OMP data_vec4,data_vec5,data_vec6,cF_lim, & !$OMP table_map,soil_class_top,soil_class_com, & !$OMP soc_vec,poc_vec,ncells_top,ncells_top_pro,& -!$OMP ncells_sub_pro,process_peat) & +!$OMP ncells_sub_pro,use_PEATMAP) & !$OMP PRIVATE(n,i,j,k,icount,t_count,i1,i2,ss_clay, & !$OMP ss_sand,ss_clay_all,ss_sand_all, & !$OMP ss_oc_all,cFamily,factor,o_cl,o_clp,ktop, & @@ -4439,7 +4439,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) if (sum(cFamily) == 0.) o_cl = 1 if (sum(cFamily) > 0.) o_cl = maxloc(cFamily, dim = 1) - if (process_peat) then + if (use_PEATMAP) then ! if 50% or more of the tile surface is covered with peat, we assume the tile is peat if (cFamily(4)/real(i) > 0.5) then o_cl = 4 @@ -4664,7 +4664,7 @@ SUBROUTINE soil_para_hwsd (nx,ny,gfiler) fac_surf = soil_class_top(n) fac = soil_class_com(n) - if(process_peat) then + if(use_PEATMAP) then ! the maximum peat soil depth is set to the value Michel used to derive parameters (1334.) if (fac_surf == 253) soildepth(n) = 5000. ! max(soildepth(n),5000.) ! reseet subsurface tro peat if surface soil type is peat diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 index d517bfe14..300ba87e2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/rmTinyCatchParaMod.F90 @@ -43,8 +43,8 @@ module rmTinyCatchParaMod public :: Get_MidTime, Time_Interp_Fac, compute_stats, c_data public :: ascat_r0, jpl_canoph, NC_VarID, init_bcs_config INTEGER, PARAMETER, public:: SRTM_maxcat = 291284 - logical, public, save :: process_peat = .true. - logical, public, save :: jpl_height = .true. + logical, public, save :: use_PEATMAP = .true. + logical, public, save :: jpl_height = .true. character*8, public, save :: LAIBCS = 'MODGEO' character*4, public, save :: SOILBCS = 'HWSD' character*6, public, save :: MODALB = 'MODIS2' @@ -85,43 +85,43 @@ SUBROUTINE init_bcs_config (LBSV) SOILBCS = 'NGDC' MODALB = 'MODIS1' GNU = 2.17 - process_peat = .false. - jpl_height = .false. + use_PEATMAP = .false. + jpl_height = .false. case ("GM4", "ICA") LAIBCS = 'GSWP2' SOILBCS = 'NGDC' MODALB = 'MODIS2' - process_peat = .false. - jpl_height = .false. + use_PEATMAP = .false. + jpl_height = .false. case ("NL3") LAIBCS = 'MODGEO' SOILBCS = 'HWSD' MODALB = 'MODIS2' - process_peat = .false. - jpl_height = .false. + use_PEATMAP = .false. + jpl_height = .false. case ("NL4") LAIBCS = 'MODGEO' SOILBCS = 'HWSD' MODALB = 'MODIS2' - process_peat = .false. - jpl_height = .true. + use_PEATMAP = .false. + jpl_height = .true. case ("NL5") LAIBCS = 'MODGEO' SOILBCS = 'HWSD' MODALB = 'MODIS2' - process_peat = .true. - jpl_height = .true. + use_PEATMAP = .true. + jpl_height = .true. case ("DEV") LAIBCS = 'MODGEO' SOILBCS = 'HWSD' MODALB = 'MODIS2' - process_peat = .true. - jpl_height = .true. + use_PEATMAP = .true. + jpl_height = .true. end select @@ -3584,7 +3584,7 @@ SUBROUTINE create_model_para_woesten (Maskfile) !c------------------------------------------------------------------------- - if(process_peat) then + if(use_PEATMAP) then fname = trim(c_data)//'SoilClasses-SoilHyd-TauParam.peatmap' else fname = trim(c_data)//'SoilClasses-SoilHyd-TauParam.dat' @@ -3608,7 +3608,7 @@ SUBROUTINE create_model_para_woesten (Maskfile) write (fout,'(i2.2,i2.2,i4.4)')nint(a_sand(n)),nint(a_clay(n)),nint(100*a_oc(n)) if(n == n_SoilClasses) then - if(process_peat) then + if(use_PEATMAP) then open (120,file=trim(losfile)//trim(fout)//'.peat', & form='formatted',status='old') else @@ -3763,7 +3763,7 @@ SUBROUTINE create_model_para_woesten (Maskfile) write(*,*)'Warnning 1: pfafstetter mismatched' stop endif - if((process_peat).and.(soil_class_top(n) == 253)) then + if((use_PEATMAP).and.(soil_class_top(n) == 253)) then meanlu = 9.3 stdev = 0.12 minlu = 8.5 @@ -3834,7 +3834,7 @@ SUBROUTINE create_model_para_woesten (Maskfile) !$OMP taberr1,taberr2,normerr1,normerr2, & !$OMP taberr3,taberr4,normerr3,normerr4, & !$OMP gwatdep,gwan,grzexcn,gfrc,soil_class_com, & -!$OMP n_threads, low_ind, upp_ind, process_peat )& +!$OMP n_threads, low_ind, upp_ind, use_PEATMAP ) & !$OMP PRIVATE(k,li,ui,n,i,watdep,wan,rzexcn,frc,ST,AC, & !$OMP COESKEW,profdep) @@ -3884,7 +3884,7 @@ SUBROUTINE create_model_para_woesten (Maskfile) if(soil_class_com(n) == 253) then ! Michel Bechtold paper - PEATCLSM_fitting_CLSM_params.R produced these data values. - if(process_peat) then + if(use_PEATMAP) then ars1(n) = -7.9514018e-03 ars2(n) = 6.2297356e-02 diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index 53c785a3d..f79225031 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -363,13 +363,13 @@ program Scale_Catch endif - ! PEAT CLSM - ensure low CATDEF on peat tiles - ! ------------------------------------------- + ! PEATCLSM - ensure low CATDEF on peat tiles where "old" restart is not also peat + ! ------------------------------------------------------------------------------- - where (catch(sca)%poros >= PEATCLSM_POROS_THRESHOLD) - catch(sca)%catdef = 25. ! changed from 100. to 25. for now, needs more thought, reichle, 2/2/22 - catch(sca)%rzexc = 0. - catch(sca)%srfexc = 0. + where ( (catch(old)%poros < PEATCLSM_POROS_THRESHOLD) .and. (catch(sca)%poros >= PEATCLSM_POROS_THRESHOLD) ) + catch(sca)%catdef = 25. + catch(sca)%rzexc = 0. + catch(sca)%srfexc = 0. end where ! Write Scaled Catch diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index 84c5d9af7..cd2bce354 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -402,13 +402,13 @@ program Scale_CatchCN endif - ! PEAT CLSM - ensure low CATDEF on peat tiles - ! ------------------------------------------- + ! PEATCLSM - ensure low CATDEF on peat tiles where "old" restart is not also peat + ! ------------------------------------------------------------------------------- - where (catch(sca)%poros >= PEATCLSM_POROS_THRESHOLD) - catch(sca)%catdef = 25. ! changed to 25. for now, needs more thought, reichle, 2/2/22 - catch(sca)%rzexc = 0. - catch(sca)%srfexc = 0. + where ( (catch(old)%poros < PEATCLSM_POROS_THRESHOLD) .and. (catch(sca)%poros >= PEATCLSM_POROS_THRESHOLD) ) + catch(sca)%catdef = 25. + catch(sca)%rzexc = 0. + catch(sca)%srfexc = 0. end where ! Write Scaled Catch