From 70df5641ea9727296b9c1ca6c5c6df474dc28710 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 9 Feb 2024 13:29:04 -0500 Subject: [PATCH 01/55] initial check in (it can be built) --- CMakeLists.txt | 2 +- GEOS_LdasGridComp.F90 | 62 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 05ddb49b..d612d8d3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -13,5 +13,5 @@ esma_add_library(${this} SRCS GEOS_LdasGridComp.F90 SUBCOMPONENTS ${alldirs} SUBDIRS Shared - DEPENDENCIES GEOSland_GridComp makebcs MAPL + DEPENDENCIES GEOSland_GridComp GEOSlandice_GridComp makebcs MAPL INCLUDES ${INC_ESMF}) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 4c1b13ed..846b87b8 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -14,6 +14,7 @@ module GEOS_LdasGridCompMod use GEOS_LandPertGridCompMod, only: LandPertSetServices => SetServices use GEOS_EnsGridCompMod, only: EnsSetServices => SetServices use GEOS_LandAssimGridCompMod, only: LandAssimSetServices => SetServices + use GEOS_LandiceGridCompMod, only : LandiceSetServices => SetServices use EASE_conv, only: ease_inverse use LDAS_TileCoordType, only: tile_coord_type , T_TILECOORD_STATE, TILECOORD_WRAP @@ -50,6 +51,7 @@ module GEOS_LdasGridCompMod ! All children integer,allocatable :: LAND(:) + integer,allocatable :: LANDICE(:) integer,allocatable :: LANDPERT(:) integer,allocatable :: METFORCE(:) integer :: ENSAVG, LANDASSIM @@ -172,6 +174,7 @@ subroutine SetServices(gc, rc) endif allocate(LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) + allocate(LANDICE(NUM_ENSEMBLE)) ! ens_id_with = 2 + number of digits = total number of chars in ensid_string ("_eXXXX") ! @@ -212,6 +215,10 @@ subroutine SetServices(gc, rc) childname='LAND'//trim(ensid_string) LAND(i) = MAPL_AddChild(gc, name=childname, ss=LandSetServices, rc=status) VERIFY_(status) + + childname='LANDICE'//trim(ensid_string) + LANDICE(i) = MAPL_AddChild(gc, name=childname, ss=LandiceSetServices, rc=status) + VERIFY_(status) enddo ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) @@ -254,6 +261,24 @@ subroutine SetServices(gc, rc) rc = status & ) VERIFY_(status) + + ! -LANDPERT-feeds-LANDICE's-imports- + call MAPL_AddConnectivity( & + gc, & + SRC_NAME = ['TApert ', 'QApert ', 'UUpert ', & + 'UWINDLMTILEpert', 'VWINDLMTILEpert', 'PCUpert ', & + 'PLSpert ', 'SNOpert ', 'DRPARpert ', & + 'DFPARpert ', 'DRNIRpert ', 'DFNIRpert ', & + 'DRUVRpert ', 'DFUVRpert ', 'LWDNSRFpert '], & + SRC_ID = LANDPERT(i), & + DST_NAME = ['TA ', 'QA ', 'UU ', 'UWINDLMTILE',& + 'VWINDLMTILE', 'PCU ', 'PLS ', 'SNO ',& + 'DRPAR ', 'DFPAR ', 'DRNIR ', 'DFNIR ',& + 'DRUVR ', 'DFUVR ', 'LWDNSRF '], & + DST_ID = LANDICE(i), & + rc = status & + ) + ! -METFORCE-feeds-LAND's-imports- call MAPL_AddConnectivity( & gc, & @@ -270,6 +295,24 @@ subroutine SetServices(gc, rc) rc = status & ) VERIFY_(status) + + ! -METFORCE-feeds-LANDICE's-imports- + call MAPL_AddConnectivity( & + gc, & + SRC_NAME = ['Psurf', 'RefH ', & + 'DUDP ', 'DUSV ', 'DUWT ', 'DUSD ', 'BCDP ', 'BCSV ', & + 'BCWT ', 'BCSD ', 'OCDP ', 'OCSV ', 'OCWT ', 'OCSD ', & + 'SUDP ', 'SUSV ', 'SUWT ', 'SUSD ', 'SSDP ', 'SSSV ' ], & + SRC_ID = METFORCE(k), & + DST_NAME = ['PS ', 'DZ ', & + 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & + 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & + 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ], & + DST_ID = LANDICE(i), & + rc = status & + ) + VERIFY_(status) + ! -LAND-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & @@ -723,13 +766,23 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) + + call MAPL_GetObjectFromGC(gcs(LANDICE(i)), CHILD_MAPL, rc=status) + VERIFY_(status) + call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) + VERIFY_(status) + call MAPL_GetObjectFromGC(gcs(LANDPERT(i)), CHILD_MAPL, rc=status) VERIFY_(status) ! CHILD = LANDPERT call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) + + ! Add LAND's tile_coord to children's GridComps call ESMF_UserCompSetInternalState(gcs(LAND(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) + call ESMF_UserCompSetInternalState(gcs(LANDICE(i)), 'TILE_COORD', tcwrap, status) + VERIFY_(status) call ESMF_UserCompSetInternalState(gcs(LANDPERT(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) enddo @@ -927,6 +980,15 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) + + igc = LANDICE(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) + VERIFY_(status) + + ! ApplyPrognPert - moved: now before calculating ensemble average that is picked up by land analysis and HISTORY; reichle 28 May 2020 igc = LANDPERT(i) call MAPL_TimerOn(MAPL, gcnames(igc)) From 7bd6302af98bf57aa3c16f3cd2514f9251fcd8c5 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 19 Feb 2024 11:48:05 -0500 Subject: [PATCH 02/55] fixed locstream and timer for LANDICE --- GEOS_LdasGridComp.F90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 846b87b8..bff58839 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -410,6 +410,7 @@ subroutine Initialize(gc, import, export, clock, rc) ! MAPL variables type(MAPL_LocStream) :: surf_locstream type(MAPL_LocStream) :: land_locstream + type(MAPL_LocStream) :: landice_locstream type(MAPL_MetaComp), pointer :: MAPL=>null() ! GC's MAPL obj type(MAPL_MetaComp), pointer :: CHILD_MAPL=>null() ! Child's MAPL obj @@ -607,11 +608,22 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_LocStreamCreate( & land_locstream, & surf_locstream, & - name=gcnames(LAND(1)), & + name=gcnames(LAND(1)), & mask=[MAPL_LAND], & rc=status & ) VERIFY_(status) + + call MAPL_LocStreamCreate( & + landice_locstream, & + surf_locstream, & + name=gcnames(LANDICE(1)), & + mask=[MAPL_LANDICE], & + rc=status & + ) + VERIFY_(status) + + call MAPL_TimerOff(MAPL, "-LocStreamCreate") ! Convert LAND's LocStream to LDAS' tile_coord and save it in the GridComp ! -get-tile-information-from-land's-locstream- @@ -769,7 +781,7 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_GetObjectFromGC(gcs(LANDICE(i)), CHILD_MAPL, rc=status) VERIFY_(status) - call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) + call MAPL_Set(CHILD_MAPL, LocStream=landice_locstream, rc=status) VERIFY_(status) call MAPL_GetObjectFromGC(gcs(LANDPERT(i)), CHILD_MAPL, rc=status) @@ -777,7 +789,6 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) - ! Add LAND's tile_coord to children's GridComps call ESMF_UserCompSetInternalState(gcs(LAND(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) @@ -987,6 +998,7 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) ! ApplyPrognPert - moved: now before calculating ensemble average that is picked up by land analysis and HISTORY; reichle 28 May 2020 From 157004f7e2b5548fb92fd875be4666f1d355769d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 9 Apr 2024 16:28:50 -0400 Subject: [PATCH 03/55] add landice grid comp --- CHANGELOG.md | 4 +++ CMakeLists.txt | 2 +- GEOS_LdasGridComp.F90 | 76 ++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 80 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 29d664c0..336f0ad1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +### Added + +- Added landice grid comp + ----------------------------- ## [v1.0.0] - 2024-03-26 diff --git a/CMakeLists.txt b/CMakeLists.txt index b4c0974e..1d02d00d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -13,7 +13,7 @@ esma_add_library(${this} SRCS GEOS_LdasGridComp.F90 SUBCOMPONENTS ${alldirs} SUBDIRS LDAS_Shared - DEPENDENCIES GEOSland_GridComp makebcs MAPL + DEPENDENCIES GEOSland_GridComp GEOSlandice_GridComp makebcs MAPL INCLUDES ${INC_ESMF}) esma_add_subdirectory(GEOSldas_App) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 4c1b13ed..bff58839 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -14,6 +14,7 @@ module GEOS_LdasGridCompMod use GEOS_LandPertGridCompMod, only: LandPertSetServices => SetServices use GEOS_EnsGridCompMod, only: EnsSetServices => SetServices use GEOS_LandAssimGridCompMod, only: LandAssimSetServices => SetServices + use GEOS_LandiceGridCompMod, only : LandiceSetServices => SetServices use EASE_conv, only: ease_inverse use LDAS_TileCoordType, only: tile_coord_type , T_TILECOORD_STATE, TILECOORD_WRAP @@ -50,6 +51,7 @@ module GEOS_LdasGridCompMod ! All children integer,allocatable :: LAND(:) + integer,allocatable :: LANDICE(:) integer,allocatable :: LANDPERT(:) integer,allocatable :: METFORCE(:) integer :: ENSAVG, LANDASSIM @@ -172,6 +174,7 @@ subroutine SetServices(gc, rc) endif allocate(LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) + allocate(LANDICE(NUM_ENSEMBLE)) ! ens_id_with = 2 + number of digits = total number of chars in ensid_string ("_eXXXX") ! @@ -212,6 +215,10 @@ subroutine SetServices(gc, rc) childname='LAND'//trim(ensid_string) LAND(i) = MAPL_AddChild(gc, name=childname, ss=LandSetServices, rc=status) VERIFY_(status) + + childname='LANDICE'//trim(ensid_string) + LANDICE(i) = MAPL_AddChild(gc, name=childname, ss=LandiceSetServices, rc=status) + VERIFY_(status) enddo ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) @@ -254,6 +261,24 @@ subroutine SetServices(gc, rc) rc = status & ) VERIFY_(status) + + ! -LANDPERT-feeds-LANDICE's-imports- + call MAPL_AddConnectivity( & + gc, & + SRC_NAME = ['TApert ', 'QApert ', 'UUpert ', & + 'UWINDLMTILEpert', 'VWINDLMTILEpert', 'PCUpert ', & + 'PLSpert ', 'SNOpert ', 'DRPARpert ', & + 'DFPARpert ', 'DRNIRpert ', 'DFNIRpert ', & + 'DRUVRpert ', 'DFUVRpert ', 'LWDNSRFpert '], & + SRC_ID = LANDPERT(i), & + DST_NAME = ['TA ', 'QA ', 'UU ', 'UWINDLMTILE',& + 'VWINDLMTILE', 'PCU ', 'PLS ', 'SNO ',& + 'DRPAR ', 'DFPAR ', 'DRNIR ', 'DFNIR ',& + 'DRUVR ', 'DFUVR ', 'LWDNSRF '], & + DST_ID = LANDICE(i), & + rc = status & + ) + ! -METFORCE-feeds-LAND's-imports- call MAPL_AddConnectivity( & gc, & @@ -270,6 +295,24 @@ subroutine SetServices(gc, rc) rc = status & ) VERIFY_(status) + + ! -METFORCE-feeds-LANDICE's-imports- + call MAPL_AddConnectivity( & + gc, & + SRC_NAME = ['Psurf', 'RefH ', & + 'DUDP ', 'DUSV ', 'DUWT ', 'DUSD ', 'BCDP ', 'BCSV ', & + 'BCWT ', 'BCSD ', 'OCDP ', 'OCSV ', 'OCWT ', 'OCSD ', & + 'SUDP ', 'SUSV ', 'SUWT ', 'SUSD ', 'SSDP ', 'SSSV ' ], & + SRC_ID = METFORCE(k), & + DST_NAME = ['PS ', 'DZ ', & + 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & + 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & + 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ], & + DST_ID = LANDICE(i), & + rc = status & + ) + VERIFY_(status) + ! -LAND-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & @@ -367,6 +410,7 @@ subroutine Initialize(gc, import, export, clock, rc) ! MAPL variables type(MAPL_LocStream) :: surf_locstream type(MAPL_LocStream) :: land_locstream + type(MAPL_LocStream) :: landice_locstream type(MAPL_MetaComp), pointer :: MAPL=>null() ! GC's MAPL obj type(MAPL_MetaComp), pointer :: CHILD_MAPL=>null() ! Child's MAPL obj @@ -564,11 +608,22 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_LocStreamCreate( & land_locstream, & surf_locstream, & - name=gcnames(LAND(1)), & + name=gcnames(LAND(1)), & mask=[MAPL_LAND], & rc=status & ) VERIFY_(status) + + call MAPL_LocStreamCreate( & + landice_locstream, & + surf_locstream, & + name=gcnames(LANDICE(1)), & + mask=[MAPL_LANDICE], & + rc=status & + ) + VERIFY_(status) + + call MAPL_TimerOff(MAPL, "-LocStreamCreate") ! Convert LAND's LocStream to LDAS' tile_coord and save it in the GridComp ! -get-tile-information-from-land's-locstream- @@ -723,13 +778,22 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) + + call MAPL_GetObjectFromGC(gcs(LANDICE(i)), CHILD_MAPL, rc=status) + VERIFY_(status) + call MAPL_Set(CHILD_MAPL, LocStream=landice_locstream, rc=status) + VERIFY_(status) + call MAPL_GetObjectFromGC(gcs(LANDPERT(i)), CHILD_MAPL, rc=status) VERIFY_(status) ! CHILD = LANDPERT call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) + ! Add LAND's tile_coord to children's GridComps call ESMF_UserCompSetInternalState(gcs(LAND(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) + call ESMF_UserCompSetInternalState(gcs(LANDICE(i)), 'TILE_COORD', tcwrap, status) + VERIFY_(status) call ESMF_UserCompSetInternalState(gcs(LANDPERT(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) enddo @@ -927,6 +991,16 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) + + igc = LANDICE(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) + VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) + + ! ApplyPrognPert - moved: now before calculating ensemble average that is picked up by land analysis and HISTORY; reichle 28 May 2020 igc = LANDPERT(i) call MAPL_TimerOn(MAPL, gcnames(igc)) From a1457796197b990d29f82c5d44363b80ee8384f6 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 9 Apr 2024 16:43:34 -0400 Subject: [PATCH 04/55] add postprocess for landice --- GEOSldas_App/lenkf.j.template | 30 +++++++++++++----------------- 1 file changed, 13 insertions(+), 17 deletions(-) diff --git a/GEOSldas_App/lenkf.j.template b/GEOSldas_App/lenkf.j.template index 7324b768..f9c31904 100644 --- a/GEOSldas_App/lenkf.j.template +++ b/GEOSldas_App/lenkf.j.template @@ -701,15 +701,17 @@ EOF if ( $NENS == 1) set ENSID ='' set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/ if (! -e $THISDIR ) mkdir -p $THISDIR - - set rstf = ${MODEL} - if (-f ${rstf}${ENSID}_internal_checkpoint ) then - set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} - /bin/mv ${rstf}${ENSID}_internal_checkpoint $tmp_file - /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst - /bin/ln -rs $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst - endif - + + set rstfs = (${MODEL} 'landice' 'landassim_obspertrseed') + foreach rstf ($rstfs) + if (-f ${rstf}${ENSID}_internal_checkpoint ) then + set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} + /bin/mv ${rstf}${ENSID}_internal_checkpoint $tmp_file + /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst + /bin/ln -rs $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_internal_rst + endif + end + set rstf = 'landpert' if (-f ${rstf}${ENSID}_internal_checkpoint ) then set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_internal_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} @@ -723,21 +725,15 @@ EOF /usr/bin/gzip $old_rst & endif - set rstf = 'landassim_obspertrseed' - if (-f ${rstf}${ENSID}_checkpoint ) then - set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${eYEAR}/M${eMON}/${EXPID}.${rstf}_rst.${eYEAR}${eMON}${eDAY}_${eHour}${eMin} - /bin/mv ${rstf}${ENSID}_checkpoint $tmp_file - /bin/rm -f $EXPDIR/input/restart/${rstf}${ENSID}_rst - /bin/ln -rs $tmp_file $EXPDIR/input/restart/${rstf}${ENSID}_rst - endif # move intermediate check point files to output/$EXPDOMAIN/rs/$ENSDIR/Yyyyy/Mmm/ directories # ------------------------------------------------------------------------------------------- set rstfiles1 = `ls ${MODEL}${ENSID}_internal_checkpoint.*` set rstfiles2 = `ls landpert${ENSID}_internal_checkpoint.*` set rstfiles3 = `ls landassim_obspertrseed${ENSID}_checkpoint.*` + set rstfiles4 = `ls landice${ENSID}_internal_checkpoint.*` - foreach rfile ( $rstfiles1 ) + foreach rfile ( $rstfiles1 $rstfiles4 ) set ThisTime = `echo $rfile | rev | cut -d'.' -f2 | rev` set TY = `echo $ThisTime | cut -c1-4` set TM = `echo $ThisTime | cut -c5-6` From 199ddc16830c214f42acbe361e4d5c7f216cdca4 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 12 Apr 2024 14:17:32 -0400 Subject: [PATCH 05/55] remove unnecessary arguments --- GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 | 2 -- GEOSmetforce_GridComp/LDAS_Interp.F90 | 4 ---- 2 files changed, 6 deletions(-) diff --git a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index b306e9fd..8b87cbb0 100644 --- a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -1033,8 +1033,6 @@ subroutine Run(gc, import, export, clock, rc) ! Interpolate MetForcing data to the end of model integration time step call LDAS_TInterpForcing( & - tile_coord%com_lon, & - tile_coord%com_lat, & zth, & internal%mf%zenav, & force_time_prv, & diff --git a/GEOSmetforce_GridComp/LDAS_Interp.F90 b/GEOSmetforce_GridComp/LDAS_Interp.F90 index 918bfcd3..951abf38 100644 --- a/GEOSmetforce_GridComp/LDAS_Interp.F90 +++ b/GEOSmetforce_GridComp/LDAS_Interp.F90 @@ -19,8 +19,6 @@ module LDAS_InterpMod contains subroutine metforcing_tinterp( & - lons, & - lats, & zth, & zenav, & force_time_prv, & @@ -57,8 +55,6 @@ subroutine metforcing_tinterp( & implicit none - real, intent(in) :: lats(:) ! tile lats - real, intent(in) :: lons(:) ! tile lons ! fix potential inconsistency between zth and zenav owing to 300s time ! step used in MAPL_SunGetInsolation() ! in ==>inout From 0c5bf7c55ccc557fd3fbf76b6d01529d03d9f88b Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 25 Apr 2024 08:31:58 -0400 Subject: [PATCH 06/55] distribute forces --- GEOS_LdasGridComp.F90 | 174 ++++++------ .../GEOS_MetforceGridComp.F90 | 250 +++++++++++++++--- 2 files changed, 288 insertions(+), 136 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index bff58839..815dc37d 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -61,7 +61,7 @@ module GEOS_LdasGridCompMod logical :: land_assim logical :: mwRTM logical :: ensemble_forcing ! switch between deterministic and ensemble forcing - + logical :: with_landice contains !BOP @@ -87,7 +87,7 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: ensid_string,childname - character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR + character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR, WITH_LANDICE_STR integer :: ens_id_width ! Local variables type(T_TILECOORD_STATE), pointer :: tcinternal @@ -96,7 +96,7 @@ subroutine SetServices(gc, rc) type(ESMF_Config) :: CF integer :: LSM_CHOICE integer :: FIRST_ENS_ID - + ! Begin... ! Get my name and setup traceback handle @@ -158,6 +158,12 @@ subroutine SetServices(gc, rc) VERIFY_(STATUS) land_assim = (trim(LAND_ASSIM_STR) /= 'NO') + call MAPL_GetResource ( MAPL, WITH_LANDICE_STR, Label="WITH_LANDICE:", DEFAULT="NO", RC=STATUS) + VERIFY_(STATUS) + WITH_LANDICE_STR = ESMF_UtilStringUpperCase(WITH_LANDICE_STR, rc=STATUS) + VERIFY_(STATUS) + with_landice = (trim(WITH_LANDICE_STR) /= 'NO') + call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) mwRTM = ( len_trim(mwRTM_file) /= 0 ) @@ -174,7 +180,7 @@ subroutine SetServices(gc, rc) endif allocate(LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) - allocate(LANDICE(NUM_ENSEMBLE)) + if (with_landice) allocate(LANDICE(NUM_ENSEMBLE)) ! ens_id_with = 2 + number of digits = total number of chars in ensid_string ("_eXXXX") ! @@ -216,9 +222,11 @@ subroutine SetServices(gc, rc) LAND(i) = MAPL_AddChild(gc, name=childname, ss=LandSetServices, rc=status) VERIFY_(status) - childname='LANDICE'//trim(ensid_string) - LANDICE(i) = MAPL_AddChild(gc, name=childname, ss=LandiceSetServices, rc=status) - VERIFY_(status) + if (with_landice) then + childname='LANDICE'//trim(ensid_string) + LANDICE(i) = MAPL_AddChild(gc, name=childname, ss=LandiceSetServices, rc=status) + VERIFY_(status) + endif enddo ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) @@ -231,19 +239,8 @@ subroutine SetServices(gc, rc) ! Connections do i=1,NUM_ENSEMBLE - ! -METFORCE-feeds-LANDPERT's-imports- k = 1 if ( ensemble_forcing ) k = i - call MAPL_AddConnectivity( & - gc, & - SHORT_NAME = ['Tair ', 'Qair ', 'Psurf ', 'Rainf_C', 'Rainf ', & - 'Snowf ', 'LWdown ', 'SWdown ', 'PARdrct', 'PARdffs', & - 'Wind ', 'RefH '], & - SRC_ID = METFORCE(k), & - DST_ID = LANDPERT(i), & - rc = status & - ) - VERIFY_(status) ! -LANDPERT-feeds-LAND's-imports- call MAPL_AddConnectivity( & gc, & @@ -262,57 +259,6 @@ subroutine SetServices(gc, rc) ) VERIFY_(status) - ! -LANDPERT-feeds-LANDICE's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['TApert ', 'QApert ', 'UUpert ', & - 'UWINDLMTILEpert', 'VWINDLMTILEpert', 'PCUpert ', & - 'PLSpert ', 'SNOpert ', 'DRPARpert ', & - 'DFPARpert ', 'DRNIRpert ', 'DFNIRpert ', & - 'DRUVRpert ', 'DFUVRpert ', 'LWDNSRFpert '], & - SRC_ID = LANDPERT(i), & - DST_NAME = ['TA ', 'QA ', 'UU ', 'UWINDLMTILE',& - 'VWINDLMTILE', 'PCU ', 'PLS ', 'SNO ',& - 'DRPAR ', 'DFPAR ', 'DRNIR ', 'DFNIR ',& - 'DRUVR ', 'DFUVR ', 'LWDNSRF '], & - DST_ID = LANDICE(i), & - rc = status & - ) - - ! -METFORCE-feeds-LAND's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['Psurf', 'RefH ', & - 'DUDP ', 'DUSV ', 'DUWT ', 'DUSD ', 'BCDP ', 'BCSV ', & - 'BCWT ', 'BCSD ', 'OCDP ', 'OCSV ', 'OCWT ', 'OCSD ', & - 'SUDP ', 'SUSV ', 'SUWT ', 'SUSD ', 'SSDP ', 'SSSV ' ], & - SRC_ID = METFORCE(k), & - DST_NAME = ['PS ', 'DZ ', & - 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & - 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & - 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ], & - DST_ID = LAND(i), & - rc = status & - ) - VERIFY_(status) - - ! -METFORCE-feeds-LANDICE's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['Psurf', 'RefH ', & - 'DUDP ', 'DUSV ', 'DUWT ', 'DUSD ', 'BCDP ', 'BCSV ', & - 'BCWT ', 'BCSD ', 'OCDP ', 'OCSV ', 'OCWT ', 'OCSD ', & - 'SUDP ', 'SUSV ', 'SUWT ', 'SUSD ', 'SSDP ', 'SSSV ' ], & - SRC_ID = METFORCE(k), & - DST_NAME = ['PS ', 'DZ ', & - 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & - 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & - 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ], & - DST_ID = LANDICE(i), & - rc = status & - ) - VERIFY_(status) - ! -LAND-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & @@ -411,6 +357,7 @@ subroutine Initialize(gc, import, export, clock, rc) type(MAPL_LocStream) :: surf_locstream type(MAPL_LocStream) :: land_locstream type(MAPL_LocStream) :: landice_locstream + type(MAPL_LocStream) :: force_locstream type(MAPL_MetaComp), pointer :: MAPL=>null() ! GC's MAPL obj type(MAPL_MetaComp), pointer :: CHILD_MAPL=>null() ! Child's MAPL obj @@ -426,7 +373,7 @@ subroutine Initialize(gc, import, export, clock, rc) character(len=ESMF_MAXSTR) :: LAND_PARAMS character(len=ESMF_MAXSTR) :: grid_type - integer :: total_nt,land_nt_local,i,j + integer :: total_nt, land_nt_local, i, j real, pointer :: LandTileLats(:) real, pointer :: LandTileLons(:) integer, pointer :: local_id(:) @@ -614,15 +561,25 @@ subroutine Initialize(gc, import, export, clock, rc) ) VERIFY_(status) - call MAPL_LocStreamCreate( & - landice_locstream, & - surf_locstream, & - name=gcnames(LANDICE(1)), & - mask=[MAPL_LANDICE], & - rc=status & + if (with_landice) then + call MAPL_LocStreamCreate( & + force_locstream, & + surf_locstream, & + name=gcnames(METFORCE(1)), & + mask=[MAPL_LAND, MAPL_LANDICE], & + rc=status & ) - VERIFY_(status) + VERIFY_(status) + call MAPL_LocStreamCreate( & + landice_locstream, & + surf_locstream, & + name=gcnames(LANDICE(1)), & + mask=[MAPL_LANDICE], & + rc=status & + ) + VERIFY_(status) + endif call MAPL_TimerOff(MAPL, "-LocStreamCreate") ! Convert LAND's LocStream to LDAS' tile_coord and save it in the GridComp @@ -760,10 +717,14 @@ subroutine Initialize(gc, import, export, clock, rc) do i = 1, NUM_ENSEMBLE call MAPL_GetObjectFromGC(gcs(METFORCE(i)), CHILD_MAPL, rc=status) VERIFY_(status) ! CHILD = METFORCE - call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) - VERIFY_(status) - call ESMF_UserCompSetInternalState(gcs(METFORCE(i)), 'TILE_COORD', tcwrap, status) - VERIFY_(status) + if ( with_landice) then + call MAPL_Set(CHILD_MAPL, LocStream=force_locstream, rc=status) + VERIFY_(status) + else + call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) + VERIFY_(status) + endif + ! exit after i=1 if using deterministic forcing if (.not. ensemble_forcing) exit enddo @@ -779,10 +740,12 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) - call MAPL_GetObjectFromGC(gcs(LANDICE(i)), CHILD_MAPL, rc=status) - VERIFY_(status) - call MAPL_Set(CHILD_MAPL, LocStream=landice_locstream, rc=status) - VERIFY_(status) + if (with_landice) then + call MAPL_GetObjectFromGC(gcs(LANDICE(i)), CHILD_MAPL, rc=status) + VERIFY_(status) + call MAPL_Set(CHILD_MAPL, LocStream=landice_locstream, rc=status) + VERIFY_(status) + endif call MAPL_GetObjectFromGC(gcs(LANDPERT(i)), CHILD_MAPL, rc=status) VERIFY_(status) ! CHILD = LANDPERT @@ -792,8 +755,6 @@ subroutine Initialize(gc, import, export, clock, rc) ! Add LAND's tile_coord to children's GridComps call ESMF_UserCompSetInternalState(gcs(LAND(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) - call ESMF_UserCompSetInternalState(gcs(LANDICE(i)), 'TILE_COORD', tcwrap, status) - VERIFY_(status) call ESMF_UserCompSetInternalState(gcs(LANDPERT(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) enddo @@ -886,7 +847,7 @@ subroutine Run(gc, import, export, clock, rc) type(MAPL_MetaComp), pointer :: MAPL ! Misc variables - integer :: igc,i, ens_id, FIRST_ENS_ID, ens_id_width + integer :: igc, i, ens_id, FIRST_ENS_ID, ens_id_width, k logical :: IAmRoot integer :: LSM_CHOICE type (ESMF_Field) :: field @@ -957,13 +918,30 @@ subroutine Run(gc, import, export, clock, rc) do i = 1, NUM_ENSEMBLE igc = METFORCE(i) call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, userRC=status) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) ! exit after i=1 if using deterministic forcing if (.not. ensemble_forcing) exit enddo + ! distribute force. ( export of focrce to the import of land, landpert and landice) + do i = 1, NUM_ENSEMBLE + k = 1 + if (ensemble_forcing) k = i + igc = METFORCE(k) + call MAPL_TimerOn(MAPL, gcnames(igc)) + + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LAND(i)), clock=clock, phase=2, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDPERT(i)), clock=clock, phase=3, userRC=status) + VERIFY_(status) + if (with_landice) then + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDICE(i)), clock=clock, phase=4, userRC=status) + VERIFY_(status) + endif + call MAPL_TimerOff(MAPL, gcnames(igc)) + enddo do i = 1,NUM_ENSEMBLE @@ -991,15 +969,15 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) - - igc = LANDICE(i) - call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) - VERIFY_(status) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) - VERIFY_(status) - call MAPL_TimerOff(MAPL, gcnames(igc)) - + if (with_landice) then + igc = LANDICE(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) + VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) + endif ! ApplyPrognPert - moved: now before calculating ensemble average that is picked up by land analysis and HISTORY; reichle 28 May 2020 igc = LANDPERT(i) diff --git a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index 8b87cbb0..2fb7ac71 100644 --- a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -59,6 +59,7 @@ module GEOS_MetforceGridCompMod ! Met forcing data type(met_force_type), pointer, contiguous :: DataPrv(:) type(met_force_type), pointer, contiguous :: DataNxt(:) + type(tile_coord_type),pointer, contiguous :: tile_coord(:) end type T_MET_FORCING ! Internal state and its wrapper @@ -70,7 +71,24 @@ module GEOS_MetforceGridCompMod type(T_METFORCE_STATE), pointer :: ptr=>null() end type METFORCE_WRAP -contains + integer, parameter :: k_force = 12 + integer, parameter :: k_aerosol = 18 + integer, parameter :: k_landice = 15 + character(len=7), dimension(k_force) :: export_name = ['Tair ', 'Qair ', 'Psurf ', & + 'Rainf_C', 'Snowf ', 'LWdown ', & + 'PARdrct', 'PARdffs', 'Wind ', & + 'RefH ', 'Rainf ', 'SWdown '] + character(len=4), dimension(k_aerosol) :: aerosol_name = [ & + 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & + 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & + 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ] + character(len=11), dimension(k_landice) :: landice_name = ['TA ', 'QA ', 'PS ', & + 'PCU ', 'SNO ', 'LWDNSRF ', & + 'DRPAR ', 'DFPAR ', 'UU ', & + 'DZ ', 'DRNIR ', 'DFNIR ', & + 'DRUVR ', 'DFUVR ', 'PLS '] + integer :: NUM_LAND_TILE, NUM_LANDICE_TILE + contains !BOP @@ -115,6 +133,8 @@ subroutine SetServices(gc, rc) rc=status & ) VERIFY_(status) + + ! phase 1 get force call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & @@ -122,6 +142,33 @@ subroutine SetServices(gc, rc) rc=status & ) VERIFY_(status) + ! phase 2: to land + call MAPL_GridCompSetEntryPoint( & + gc, & + ESMF_METHOD_RUN, & + DistributeForcetoLand, & + rc=status & + ) + VERIFY_(status) + + ! phase 3: to landpert + call MAPL_GridCompSetEntryPoint( & + gc, & + ESMF_METHOD_RUN, & + DistributeForcetoLandPert, & + rc=status & + ) + VERIFY_(status) + + ! phase 4: to landice + call MAPL_GridCompSetEntryPoint( & + gc, & + ESMF_METHOD_RUN, & + DistributeForcetoLandIce, & + rc=status & + ) + VERIFY_(status) + call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_FINALIZE, & @@ -555,15 +602,19 @@ subroutine Initialize(gc, import, export, clock, rc) ! Internal private state variables type(T_METFORCE_STATE), pointer :: internal=>null() type(METFORCE_WRAP) :: wrap - type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), pointer :: tile_coord(:)=>null() ! Misc variables - integer :: land_nt_local, k, NUM_ENSEMBLE + integer :: nt_local, k, NUM_ENSEMBLE integer :: ForceDtStep type(met_force_type) :: mf_nodata logical :: MERRA_file_specs, ensemble_forcing logical :: backward_looking_fluxes + real, pointer :: TileLats(:) + real, pointer :: TileLons(:) + integer, pointer :: i_indg(:) + integer, pointer :: j_indg(:) + integer, pointer :: tiletype(:) integer :: AEROSOL_DEPOSITION type(MAPL_LocStream) :: locstream @@ -596,21 +647,30 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) internal => wrap%ptr - ! Get component's internal tile_coord variable - call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) - VERIFY_(status) - tile_coord => tcwrap%ptr%tile_coord - - ! Number of land tiles (on local PE) call MAPL_Get(MAPL, LocStream=locstream) VERIFY_(status) call MAPL_LocStreamGet( & locstream, & - NT_LOCAL=land_nt_local, & + NT_LOCAL=nt_local, & + TILELATS=TileLats, & + TILELONS=TileLons, & + LOCAL_I =i_indg, & + LOCAL_J =j_indg, & + TILETYPE=tiletype, & rc=status & ) VERIFY_(status) + NUM_LAND_TILE = count(tiletype == MAPL_LAND) + NUM_LANDICE_TILE = count(tiletype == MAPL_LANDICE) + + + allocate(mf%tile_coord(nt_local)) + mf%tile_coord(:)%com_lon = TileLons + mf%tile_coord(:)%com_lat = TileLats + mf%tile_coord(:)%i_indg = i_indg + mf%tile_coord(:)%j_indg = j_indg + call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & DEFAULT=0, RC=STATUS) @@ -663,12 +723,12 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) ! -allocate-memory-for-metforcing-data- mf_nodata = nodata_generic - allocate(mf%DataPrv(land_nt_local), source=mf_nodata, stat=status) + allocate(mf%DataPrv(nt_local), source=mf_nodata, stat=status) VERIFY_(status) - allocate(mf%DataNxt(land_nt_local), source=mf_nodata, stat=status) + allocate(mf%DataNxt(nt_local), source=mf_nodata, stat=status) VERIFY_(status) ! -allocate-memory-for-avg-zenith-angle - allocate(mf%zenav(land_nt_local), source=nodata_generic, stat=status) + allocate(mf%zenav(nt_local), source=nodata_generic, stat=status) VERIFY_(status) call MAPL_GetResource ( MAPL, ENS_FORCING_STR, Label="ENSEMBLE_FORCING:", DEFAULT="NO", RC=STATUS) VERIFY_(STATUS) @@ -686,6 +746,7 @@ subroutine Initialize(gc, import, export, clock, rc) endif ! Put MetForcing in Ldas' pvt internal state internal%mf = mf + tile_coord => internal%mf%tile_coord ! Create alarm for MetForcing ! -create-nonsticky-alarm- MetForcingAlarm = ESMF_AlarmCreate( & @@ -710,7 +771,7 @@ subroutine Initialize(gc, import, export, clock, rc) ForceDtStep, & internal%mf%Path, & internal%mf%Tag, & - land_nt_local, & + nt_local, & tile_coord, & internal%mf%hinterp, & AEROSOL_DEPOSITION, & @@ -783,21 +844,18 @@ subroutine Run(gc, import, export, clock, rc) ! Private internal state variables type(T_METFORCE_STATE), pointer :: internal=>null() type(METFORCE_WRAP) :: wrap - type(TILECOORD_WRAP) :: tcwrap ! LDAS' tile_coord variable type(tile_coord_type), pointer :: tile_coord(:) ! Misc variables - integer :: land_nt_local ! number of LAND tiles in local PE + integer :: nt_local ! number of tiles in local PE integer :: comm logical :: IAmRoot integer :: fdtstep - integer :: YEAR, DAY_OF_YEAR, SEC_OF_DAY,n - real, pointer :: LandTileLats(:) - real, pointer :: LandTileLons(:) + real, pointer :: TileLats(:) + real, pointer :: TileLons(:) real, allocatable :: zth(:), slr(:), zth_tmp(:) type(met_force_type), allocatable :: mfDataNtp(:) type(met_force_type), pointer, contiguous :: DataTmp(:)=>null() - real, allocatable :: tmpreal(:) type(met_force_type) :: mf_nodata logical :: MERRA_file_specs @@ -868,6 +926,7 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr + tile_coord => internal%mf%tile_coord call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & DEFAULT=1, RC=STATUS) @@ -877,9 +936,9 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_LocStreamGet( & locstream, & - NT_LOCAL=land_nt_local, & - TILELATS=LandTileLats, & - TILELONS=LandTileLons, & + NT_LOCAL=nt_local, & + TILELATS=TileLats, & + TILELONS=TileLons, & rc=status & ) VERIFY_(status) @@ -888,11 +947,11 @@ subroutine Run(gc, import, export, clock, rc) call MAPL_Get(MAPL, orbit=orbit) ! Allocate memory for zenith angle - allocate(zth(land_nt_local), source=nodata_generic, stat=status) + allocate(zth(nt_local), source=nodata_generic, stat=status) VERIFY_(status) - allocate(slr(land_nt_local), source=nodata_generic, stat=status) + allocate(slr(nt_local), source=nodata_generic, stat=status) VERIFY_(status) - allocate(zth_tmp(land_nt_local), source=nodata_generic, stat=status) + allocate(zth_tmp(nt_local), source=nodata_generic, stat=status) VERIFY_(status) ! Convert forcing time interval to seconds @@ -902,10 +961,6 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_ClockGetAlarm(clock, 'MetForcing', MetForcingAlarm, rc=status) VERIFY_(status) - ! Get component's internal tile_coord variable - call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) - VERIFY_(status) - tile_coord => tcwrap%ptr%tile_coord ! Time stamp of next model step ! -get-model-time-step- @@ -938,7 +993,7 @@ subroutine Run(gc, import, export, clock, rc) fdtstep, & internal%mf%Path, & internal%mf%Tag, & - land_nt_local, & + nt_local, & tile_coord, & internal%mf%hinterp, & AEROSOL_DEPOSITION, & @@ -956,8 +1011,8 @@ subroutine Run(gc, import, export, clock, rc) ! -compute-average-zenith-angle-over-daylight-part-of-forcing-interval- call MAPL_SunGetInsolation( & - LandTileLons, & - LandTileLats, & + TileLons, & + TileLats, & orbit, & zth_tmp, & slr, & @@ -973,7 +1028,7 @@ subroutine Run(gc, import, export, clock, rc) ! dayOfYear=DAY_OF_YEAR, RC=STATUS) ! VERIFY_(STATUS) - ! call zenith(DAY_OF_YEAR,SEC_OF_DAY,fdtstep,ModelTimeStep,land_nt_local,tile_coord%com_lon, & + ! call zenith(DAY_OF_YEAR,SEC_OF_DAY,fdtstep,ModelTimeStep,nt_local,tile_coord%com_lon, & ! tile_coord%com_lat,internal%mf%zenav) @@ -989,8 +1044,8 @@ subroutine Run(gc, import, export, clock, rc) ! Compute zenith angle at the next time step call MAPL_SunGetInsolation( & - LandTileLons, & - LandTileLats, & + TileLons, & + TileLats, & orbit, & zth_tmp, & slr, & @@ -1005,7 +1060,7 @@ subroutine Run(gc, import, export, clock, rc) !call ESMF_TimeGet(ModelTimeNxt, YY=YEAR, S=SEC_OF_DAY, & ! dayOfYear=DAY_OF_YEAR, RC=STATUS) !VERIFY_(STATUS) - !do n=1, land_nt_local + !do n=1, nt_local ! call solar(tile_coord(n)%com_lon,tile_coord(n)%com_lat, DAY_OF_YEAR,SEC_OF_DAY,zth(n),slr(n)) !enddo @@ -1028,7 +1083,7 @@ subroutine Run(gc, import, export, clock, rc) ! Allocate memory for interpolated MetForcing data mf_nodata = nodata_generic - allocate(mfDataNtp(land_nt_local), source=mf_nodata, stat=status) + allocate(mfDataNtp(nt_local), source=mf_nodata, stat=status) VERIFY_(status) ! Interpolate MetForcing data to the end of model integration time step @@ -1222,6 +1277,125 @@ subroutine Run(gc, import, export, clock, rc) end subroutine Run + subroutine DistributeForcetoLand(gc, export, land_import, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_State), intent(inout) :: land_import ! Import state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + real, pointer :: out1d(:), in1d(:) + real, pointer :: out2d(:,:), in2d(:,:) + integer :: k, AEROSOL_DEPOSITION, status + type(MAPL_MetaComp), pointer :: MAPL + character(len=ESMF_MAXSTR) :: Iam + Iam = "metForce::DistributeForcetoLand" + + call MAPL_GetObjectFromGC(gc, MAPL, _RC) + call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", DEFAULT=1, _RC) + if(AEROSOL_DEPOSITION /=0) then + do k = 1, k_aerosol + call MAPL_GetPointer(export, out2d, aerosol_name(k), _RC) + call MAPL_GetPointer(land_import, in2d, aerosol_name(k), _RC) + in2d(:,:) = out2d(1:NUM_LAND_TILE, :) + enddo + endif + + call MAPL_GetPointer(export, out1d, 'Psurf', _RC) + call MAPL_GetPointer(land_import, in1d, 'PS', _RC) + in1d = out1d(1:NUM_LAND_TILE) + call MAPL_GetPointer(export, out1d, 'RefH', _RC) + call MAPL_GetPointer(land_import, in1d, 'DZ', _RC) + in1d = out1d(1:NUM_LAND_TILE) + RETURN_(ESMF_SUCCESS) + end subroutine DistributeForcetoLand + + subroutine DistributeForcetoLandPert(gc, export, landpert_import, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_State), intent(inout) :: landpert_import ! Import state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + + real, pointer :: out1d(:), in1d(:) + integer :: k, status + character(len=ESMF_MAXSTR) :: Iam + Iam = "metForce::DistributeForcetoLandPert" + + do k = 1, k_force + call MAPL_GetPointer(export, out1d, trim(export_name(k)), _RC) + call MAPL_GetPointer(landpert_import, in1d, trim(export_name(k)), _RC) + in1d = out1d(1:NUM_LAND_TILE) + enddo + RETURN_(ESMF_SUCCESS) + end subroutine DistributeForcetoLandPert + + subroutine DistributeForcetoLandIce(gc, export, landice_import, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_State), intent(inout) :: landice_import ! Import state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + integer :: k, i1, i2, AEROSOL_DEPOSITION, status + real, pointer :: out1d(:), in1d(:), tmp(:) + real, pointer :: out2d(:,:), in2d(:,:) + real, allocatable :: tmpreal(:) + type(MAPL_MetaComp), pointer :: MAPL + character(len=ESMF_MAXSTR) :: Iam + Iam = "metForce::DistributeForcetoLandice" + + if (NUM_LANDICE_TILE == 0) then + RETURN_(ESMF_SUCCESS) + endif + + i1 = NUM_LAND_TILE + 1 + i2 = NUM_LAND_TILE + NUM_LANDICE_TILE + ! Get MAPL obj + call MAPL_GetObjectFromGC(gc, MAPL, _RC) + call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", DEFAULT=1, _RC) + if(AEROSOL_DEPOSITION /=0) then + do k = 1, k_aerosol + call MAPL_GetPointer(export, out2d, aerosol_name(k), _RC) + call MAPL_GetPointer(landice_import, in2d, aerosol_name(k), _RC) + in2d(:,:) = out2d(i1:i2, :) + VERIFY_(status) + enddo + endif + + do k = 1, k_force - 2 + call MAPL_GetPointer(export, out1d, trim(export_name(k)), _RC) + call MAPL_GetPointer(landice_import, in1d, trim(landice_name(k)), _RC) + in1d = out1d(i1:i2) + enddo + + call MAPL_GetPointer(export, out1d, 'Wind', _RC) + call MAPL_GetPointer(landice_import, in1d, 'UWINDLMTILE', _RC) + in1d = out1d(i1:i2) + call MAPL_GetPointer(landice_import, in1d, 'VWINDLMTILE', _RC) + in1d = 0. + + call MAPL_GetPointer(export, out1d, 'Rainf', _RC) + call MAPL_GetPointer(export, tmp, 'Rainf_C', _RC) + call MAPL_GetPointer(landice_import, in1d, 'PLS', _RC) + in1d = out1d(i1:i2) - tmp(i1:i2) + + allocate(tmpreal(NUM_LANDICE_TILE), stat=status) + call MAPL_GetPointer(export, out1d, 'SWdown', _RC) + tmpreal = 0.5* out1d(i1:i2) + call MAPL_GetPointer(landice_import, in1d, 'DRNIR', _RC) + in1d = 0.5 * tmpreal + call MAPL_GetPointer(landice_import, in1d, 'DFNIR', _RC) + in1d = 0.5 * tmpreal + + call MAPL_GetPointer(export, out1d, 'PARdrct', _RC) + call MAPL_GetPointer(landice_import, in1d, 'DRUVR', _RC) + in1d = 0.5* tmpreal - out1d(i1:i2) + call MAPL_GetPointer(export, out1d, 'PARdffs', _RC) + call MAPL_GetPointer(landice_import, in1d, 'DFUVR', _RC) + in1d = 0.5* tmpreal - out1d(i1:i2) + deallocate(tmpreal) + + RETURN_(ESMF_SUCCESS) + end subroutine DistributeForcetoLandIce !BOP From 430a4d61b818df01cf5b67b1db96356f87971188 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 25 Apr 2024 13:50:13 -0400 Subject: [PATCH 07/55] use partial tiel_coord in metforce --- GEOS_LdasGridComp.F90 | 3 +++ .../GEOS_MetforceGridComp.F90 | 22 ++++++++++++++----- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 815dc37d..5ff7947a 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -724,6 +724,8 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) endif + call ESMF_UserCompSetInternalState(gcs(METFORCE(i)), 'TILE_COORD', tcwrap, status) + VERIFY_(status) ! exit after i=1 if using deterministic forcing if (.not. ensemble_forcing) exit @@ -757,6 +759,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) call ESMF_UserCompSetInternalState(gcs(LANDPERT(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) + enddo if (land_assim .or. mwRTM) then diff --git a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index 2fb7ac71..b301f982 100644 --- a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -602,10 +602,12 @@ subroutine Initialize(gc, import, export, clock, rc) ! Internal private state variables type(T_METFORCE_STATE), pointer :: internal=>null() type(METFORCE_WRAP) :: wrap + type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), pointer :: tile_coord(:)=>null() + type(tile_coord_type), pointer :: tile_coord_tmp(:)=>null() ! Misc variables - integer :: nt_local, k, NUM_ENSEMBLE + integer :: nt_local, k, NUM_ENSEMBLE, i1, i2 integer :: ForceDtStep type(met_force_type) :: mf_nodata logical :: MERRA_file_specs, ensemble_forcing @@ -647,6 +649,11 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) internal => wrap%ptr + ! Get component's internal tile_coord variable + call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) + VERIFY_(status) + tile_coord_tmp => tcwrap%ptr%tile_coord + call MAPL_Get(MAPL, LocStream=locstream) VERIFY_(status) call MAPL_LocStreamGet( & @@ -666,10 +673,15 @@ subroutine Initialize(gc, import, export, clock, rc) allocate(mf%tile_coord(nt_local)) - mf%tile_coord(:)%com_lon = TileLons - mf%tile_coord(:)%com_lat = TileLats - mf%tile_coord(:)%i_indg = i_indg - mf%tile_coord(:)%j_indg = j_indg + mf%tile_coord(1:NUM_LAND_TILE) = tile_coord_tmp + if (NUM_LANDICE_TILE > 0 ) then + i1 = NUM_LAND_TILE + 1 + i2 = NUM_LAND_TILE + NUM_LANDICE_TILE + mf%tile_coord(i1:i2)%com_lon = TileLons(i1:i2) + mf%tile_coord(i1:i2)%com_lat = TileLats(i1:i2) + mf%tile_coord(i1:i2)%i_indg = i_indg(i1:i2) + mf%tile_coord(i1:i2)%j_indg = j_indg(i1:i2) + endif call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & DEFAULT=0, RC=STATUS) From 2184d72191c5b30bcd4cfd5ecf802be435423f79 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 26 Apr 2024 10:21:06 -0400 Subject: [PATCH 08/55] change local index to global index --- .../GEOS_MetforceGridComp.F90 | 41 +++++++++++-------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index b301f982..06f59c92 100644 --- a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -607,7 +607,7 @@ subroutine Initialize(gc, import, export, clock, rc) type(tile_coord_type), pointer :: tile_coord_tmp(:)=>null() ! Misc variables - integer :: nt_local, k, NUM_ENSEMBLE, i1, i2 + integer :: nt_local, k, NUM_ENSEMBLE, i1, i2, j1, j2 integer :: ForceDtStep type(met_force_type) :: mf_nodata logical :: MERRA_file_specs, ensemble_forcing @@ -617,7 +617,6 @@ subroutine Initialize(gc, import, export, clock, rc) integer, pointer :: i_indg(:) integer, pointer :: j_indg(:) integer, pointer :: tiletype(:) - integer :: AEROSOL_DEPOSITION type(MAPL_LocStream) :: locstream character(len=ESMF_MAXSTR) :: grid_type, ENS_FORCING_STR, ens_forcing_path @@ -671,14 +670,35 @@ subroutine Initialize(gc, import, export, clock, rc) NUM_LAND_TILE = count(tiletype == MAPL_LAND) NUM_LANDICE_TILE = count(tiletype == MAPL_LANDICE) + call MAPL_GetResource(MAPL, grid_type,Label="GEOSldas.GRID_TYPE:",RC=STATUS) + VERIFY_(STATUS) + + if(trim(grid_type) == "Cubed-Sphere" ) then + call ESMF_GridCompGet(gc, grid=agrid, rc=status) + VERIFY_(status) + call MAPL_GridGet(agrid, globalCellCountPerDim=dims, rc=status) + VERIFY_(STATUS) + im_world_cs = dims(1) + !change local index to global. Only cubed-sphere grid cares about the index in geting forcing + call ESMF_GRID_INTERIOR(agrid,I1,I2,J1,J2) + i_indg = i_indg + i1 -1 + j_indg = j_indg + j1 -1 + if (any(tile_coord_tmp%i_indg /= i_indg(1:NUM_LAND_TILE))) then + _FAIL('i_indg index does not match') + endif + if (any(tile_coord_tmp%j_indg /= j_indg(1:NUM_LAND_TILE))) then + _FAIL('j_indg index does not match') + endif + endif allocate(mf%tile_coord(nt_local)) mf%tile_coord(1:NUM_LAND_TILE) = tile_coord_tmp - if (NUM_LANDICE_TILE > 0 ) then + + if (NUM_LANDICE_TILE > 0 ) then i1 = NUM_LAND_TILE + 1 i2 = NUM_LAND_TILE + NUM_LANDICE_TILE - mf%tile_coord(i1:i2)%com_lon = TileLons(i1:i2) - mf%tile_coord(i1:i2)%com_lat = TileLats(i1:i2) + mf%tile_coord(i1:i2)%com_lon = TileLons(i1:i2)*MAPL_RADIANS_TO_DEGREES + mf%tile_coord(i1:i2)%com_lat = TileLats(i1:i2)*MAPL_RADIANS_TO_DEGREES mf%tile_coord(i1:i2)%i_indg = i_indg(i1:i2) mf%tile_coord(i1:i2)%j_indg = j_indg(i1:i2) endif @@ -686,17 +706,6 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & DEFAULT=0, RC=STATUS) - call MAPL_GetResource(MAPL, grid_type,Label="GEOSldas.GRID_TYPE:",RC=STATUS) - VERIFY_(STATUS) - - if(trim(grid_type) == "Cubed-Sphere" ) then - call ESMF_GridCompGet(gc, grid=agrid, rc=status) - VERIFY_(status) - call MAPL_GridGet(agrid, globalCellCountPerDim=dims, rc=status) - VERIFY_(STATUS) - im_world_cs = dims(1) - endif - call MAPL_GetResource(MAPL, gridname,Label="GEOSldas.GRIDNAME:",RC=STATUS) VERIFY_(STATUS) if( index(trim(gridname), 'EASE') /=0) call set_neighbor_offset(0.0001) From 9c0b76fa9856ca300889fe3e0cd38d3e98443972 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 26 Apr 2024 14:38:12 -0400 Subject: [PATCH 09/55] remove name '_internal" from landassim_obs... --- GEOSldas_App/lenkf_j_template.py | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/GEOSldas_App/lenkf_j_template.py b/GEOSldas_App/lenkf_j_template.py index 8177a487..41bf3285 100644 --- a/GEOSldas_App/lenkf_j_template.py +++ b/GEOSldas_App/lenkf_j_template.py @@ -716,7 +716,7 @@ set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${{eYEAR}}/M${{eMON}}/ if (! -e $THISDIR ) mkdir -p $THISDIR - set rstfs = (${{MODEL}} 'landice' 'landassim_obspertrseed') + set rstfs = (${{MODEL}} 'landice') foreach rstf ( $rstfs ) if (-f ${{rstf}}${{ENSID}}_internal_checkpoint ) then set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${{eYEAR}}/M${{eMON}}/${{EXPID}}.${{rstf}}_internal_rst.${{eYEAR}}${{eMON}}${{eDAY}}_${{eHour}}${{eMin}} @@ -726,6 +726,14 @@ endif end + set rstf = 'landassim_obspertrseed' + if (-f ${{rstf}}${{ENSID}}_checkpoint ) then + set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${{eYEAR}}/M${{eMON}}/${{EXPID}}.${{rstf}}_rst.${{eYEAR}}${{eMON}}${{eDAY}}_${{eHour}}${{eMin}} + /bin/mv ${{rstf}}${{ENSID}}_checkpoint $tmp_file + /bin/rm -f $EXPDIR/input/restart/${{rstf}}${{ENSID}}_rst + /bin/ln -rs $tmp_file $EXPDIR/input/restart/${{rstf}}${{ENSID}}_rst + endif + set rstf = 'landpert' if (-f ${{rstf}}${{ENSID}}_internal_checkpoint ) then set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${{eYEAR}}/M${{eMON}}/${{EXPID}}.${{rstf}}_internal_rst.${{eYEAR}}${{eMON}}${{eDAY}}_${{eHour}}${{eMin}} From dddd9f114052ed746b2bd941405d8108bfc1108d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 29 Apr 2024 09:41:33 -0400 Subject: [PATCH 10/55] rename model to landmodel --- GEOSldas_App/ldas_setup | 2 +- GEOSldas_App/lenkf_j_template.py | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 2252391a..93ecd471 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -1357,7 +1357,7 @@ class LDASsetup: MY_EXPDOMAIN = self.rqdExeInp['EXP_DOMAIN'], MY_LOGFILE = my_logfile, MY_ERRFILE = my_errfile, - MY_MODEL = self.catch, + MY_LANDMODEL = self.catch, MY_POSTPROC_HIST = str(self.rqdExeInp['POSTPROC_HIST']), MY_FIRST_ENS_ID = str(self.first_ens_id), MY_LADAS_COUPLING = str(self.ladas_coupling), diff --git a/GEOSldas_App/lenkf_j_template.py b/GEOSldas_App/lenkf_j_template.py index 41bf3285..dee800c6 100644 --- a/GEOSldas_App/lenkf_j_template.py +++ b/GEOSldas_App/lenkf_j_template.py @@ -102,7 +102,7 @@ setenv HOMDIR $EXPDIR/run/ setenv SCRDIR $EXPDIR/scratch -setenv MODEL {MY_MODEL} +setenv LANDMODEL {MY_LANDMODEL} setenv MYNAME `finger $USER | cut -d: -f3 | head -1` setenv POSTPROC_HIST {MY_POSTPROC_HIST} @@ -716,7 +716,7 @@ set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${{eYEAR}}/M${{eMON}}/ if (! -e $THISDIR ) mkdir -p $THISDIR - set rstfs = (${{MODEL}} 'landice') + set rstfs = (${{LANDMODEL}} 'landice') foreach rstf ( $rstfs ) if (-f ${{rstf}}${{ENSID}}_internal_checkpoint ) then set tmp_file = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${{eYEAR}}/M${{eMON}}/${{EXPID}}.${{rstf}}_internal_rst.${{eYEAR}}${{eMON}}${{eDAY}}_${{eHour}}${{eMin}} @@ -750,7 +750,7 @@ # move intermediate check point files to output/$EXPDOMAIN/rs/$ENSDIR/Yyyyy/Mmm/ directories # ------------------------------------------------------------------------------------------- - set rstfiles1 = `ls ${{MODEL}}${{ENSID}}_internal_checkpoint.*` + set rstfiles1 = `ls ${{LANDMODEL}}${{ENSID}}_internal_checkpoint.*` set rstfiles2 = `ls landpert${{ENSID}}_internal_checkpoint.*` set rstfiles3 = `ls landassim_obspertrseed${{ENSID}}_checkpoint.*` set rstfiles4 = `ls landice${{ENSID}}_internal_checkpoint.*` @@ -761,8 +761,8 @@ set TM = `echo $ThisTime | cut -c5-6` set THISDIR = $EXPDIR/output/$EXPDOMAIN/rs/$ENSDIR/Y${{TY}}/M${{TM}}/ if (! -e $THISDIR ) mkdir -p $THISDIR - /bin/mv $rfile ${{THISDIR}}${{EXPID}}.${{MODEL}}_internal_rst.${{ThisTime}}.nc4 - /usr/bin/gzip ${{THISDIR}}${{EXPID}}.${{MODEL}}_internal_rst.${{ThisTime}}.nc4 & + /bin/mv $rfile ${{THISDIR}}${{EXPID}}.${{LANDMODEL}}_internal_rst.${{ThisTime}}.nc4 + /usr/bin/gzip ${{THISDIR}}${{EXPID}}.${{LANDMODEL}}_internal_rst.${{ThisTime}}.nc4 & end foreach rfile ( $rstfiles2 ) From d553e784e9d78f48098255c69c62f0323cf88131 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 17 Jun 2024 15:43:47 -0400 Subject: [PATCH 11/55] first check in for mapping files --- GEOSldas_App/preprocess_ldas_routines.F90 | 513 +++++++++++----------- 1 file changed, 265 insertions(+), 248 deletions(-) diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 70af1d7a..1409de2d 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -20,6 +20,11 @@ module preprocess_ldas_routines ! - is_in_domain() [from LDAS_ensdrv_functions.F90] ! - word_count() [from LDAS_ensdrv_functions.F90] ! - open_land_param_file() [from LDAS_ensdrv_functions.F90] + + ! xxx_g or _global include all tiles in the types() + ! r2g ( restart to global) + ! f2r ( simualtion to restart) + ! f2g ( simulation to global), f2g = r2g(f2r) use netcdf @@ -96,17 +101,17 @@ module preprocess_ldas_routines ! Tile type for land that is to be excluded from the simulation domain. ! (GEOSldas allows for non-global simulations and repeated "zooming" ! of the domain while MAPL generally assumes a complete (global) tile - ! space. The *_ExcludeFromDomain tile type makes it possible to work + ! space. The MAP_ExcludeFromDomain is added to the origial tile type and makes it possible to work ! with complete (global) tile files (ie, make use of MAPL functionality) ! and also maintain GEOSldas functionality. - integer, parameter :: MAPL_Land_ExcludeFromDomain = 1100 + integer, parameter :: MAPL_ExcludeFromDomain = 1000 ! added to original tile type to be excluded contains ! ******************************************************************** - subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, SURFLAY, f2g_file) + subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, SURFLAY, mapping_file, types) implicit none character(*) :: orig_tile @@ -116,8 +121,10 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, character(*) :: exp_id character(*) :: ymdhm character(*) :: SURFLAY - character(*) :: f2g_file + character(*) :: mapping_file + integer, dimension(:), optional, intent(in) :: types + real :: minlon,maxlon,minlat,maxlat character(len=512):: exclude_file,include_file character(len=512):: bcs_path @@ -126,14 +133,14 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, integer :: n - type(grid_def_type) :: tile_grid_g,tile_grid_d - type(tile_coord_type), dimension(:), pointer :: tile_coord_g => null() - type(tile_coord_type), dimension(:), pointer :: tile_coord_d => null() - integer, dimension(:), pointer :: f2g => null() - integer, dimension(:), pointer :: d2g => null() - integer, dimension(:), pointer :: d2f => null() - integer :: N_catg, N_catd,n1,n2,N_catf - + type(grid_def_type) :: tile_grid_g,tile_grid_r + type(tile_coord_type), dimension(:), pointer :: tile_coord_r => null() + type(tile_coord_type), dimension(:), pointer :: tile_coord_f => null() + integer, dimension(:), pointer :: f2r => null() + integer, dimension(:), pointer :: r2g => null() ! restart domain to global + integer :: N_catg, N_types,n1,n2,N_catf + integer, allocatable, dimension(:) :: tile_types + integer, allocatable, dimension(:) :: N_tiles_restart, N_tiles_simulation type(cat_param_type), dimension(:), allocatable :: cp real :: dzsf @@ -154,7 +161,17 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, print*,"no catchment definition file:" , catch_def_file endif + if (present(types)) then + tile_types = types + else + tile_types = [MAPL_LAND] + endif + call LDAS_read_til_file(orig_tile,catch_def_file, tile_grid_g, tile_coord_r, N_catg, r2g, types) + + N_tiles_r=size(tile_coord_r) + + ! include and exclude files are absolute if(d_exist) then open (10, file=trim(domain_def), delim='apostrophe', action='read', status='old') read (10, nml= domain_inputs) @@ -168,63 +185,48 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, include_file = ' ' endif - call LDAS_read_til_file(orig_tile,catch_def_file,tile_grid_g,tile_coord_g,f2g) - - N_catg=size(tile_coord_g) - - ! include and exclude files are absolute - - call domain_setup( & - N_catg, tile_coord_g, & + call domain_setup( & + N_tiles_r, tile_coord_r, & tile_grid_g, & - ' ', exclude_file, ' ', include_file, & + ' ', exclude_file, ' ', include_file, & trim(out_path), 'exp_domain ', trim(exp_id), & minlon, minlat, maxlon, maxlat, & - N_catd, d2g, tile_coord_d, & - tile_grid_d ) - - allocate(cp(N_catd)) + N_tiles_f, f2r, tile_coord_f, & + tile_grid_f) + + N_catf = count(tile_coord_f(:)%tpy == MAPL_LAND) + + allocate(cp(N_catf)) read(SURFLAY,*) dzsf print*, "SURFLAY: ", dzsf n1 = index(catch_def_file,'/clsm/') bcs_path(1:n1-1) = catch_def_file(1:n1-1) - call read_cat_param( N_catg, N_catd, d2g, tile_coord_d, dzsf, bcs_path(1:n1-1), bcs_path(1:n1-1),bcs_path(1:n1-1), & + call read_cat_param( N_catg, N_catf, tile_coord_f, dzsf, bcs_path(1:n1-1), bcs_path(1:n1-1),bcs_path(1:n1-1), & cp ) - call write_cat_param(cp,N_catd) - - allocate(d2f(N_catd)) - d2f = 0 - N_catf = size(f2g) - if( N_catf /= N_catg) then - n = 1 - do n1 = 1,N_catd - do n2 = n, N_catf - if (d2g(n1) == f2g(n2)) then - d2f(n1) = n2 - n = n2+1 - exit - endif - enddo - enddo - if(any(d2f == 0)) stop " Domain includes those excluded tiles" - print*," f2g now is d2f " - else - d2f = d2g - endif - open(40,file=f2g_file,form='formatted',action='write') - write(40,*)N_catf - write(40,*)N_catd - do n=1,N_catd - write(40,*)d2f(n) + call write_cat_param(cp,N_catf) + + N_types = size(tile_types) + allocate(N_tiles_restarts(N_types), N_tiles_simulations(N_types)) + do n=1, N_types + N_tiles_restarts(n) = count(tilecoord_r%typ == tile_types(n)) + N_tiles_simulations(n) = count(tilecoord_f%typ == tile_types(n)) enddo - do n=1,N_catd - write(40,*)d2g(n) + + open(40,file=mapping_file,form='formatted',action='write') + write(40,*)N_types + write(40,*)N_tiles_restarts ! length N_types + write(40,*)N_tiles_simulations ! length N_types + + do n=1,N_tiles_f + write(40,*)f2r(n) + enddo + do n=1,N_files_r + write(40,*)r2g(n) enddo close(40) - if (associated(f2g)) deallocate(f2g) - if (associated(d2g)) deallocate(d2g) - if (associated(d2f)) deallocate(d2f) + if (associated(f2r)) deallocate(f2r) + if (associated(r2g)) deallocate(r2g) contains @@ -327,12 +329,12 @@ end function is_cat_in_box ! ******************************************************************** subroutine domain_setup( & - N_cat_global, tile_coord_global, & + N_tile_r, tile_coord_r, & tile_grid_g, & exclude_path, exclude_file, include_path, include_file, & work_path, exp_domain, exp_id, & minlon, minlat, maxlon, maxlat, & - N_cat_domain, d2g, tile_coord, tile_grid_d ) + N_tile_f, f2r, tile_coord_f, tile_grid_f, types ) ! Set up modeling domain and determine index vectors mapping from the ! domain to global catchment space. @@ -383,9 +385,9 @@ subroutine domain_setup( & implicit none - integer, intent(in) :: N_cat_global + integer, intent(in) :: N_tile_r - type(tile_coord_type), dimension(:), pointer :: tile_coord_global ! input + type(tile_coord_type), dimension(:), pointer :: tile_coord_r ! input type(grid_def_type), intent(in) :: tile_grid_g @@ -399,23 +401,24 @@ subroutine domain_setup( & real, intent(in) :: minlon, minlat ! from nml inputs real, intent(in) :: maxlon, maxlat ! from nml inputs - integer, intent(out) :: N_cat_domain + integer, intent(out) :: N_tile_f - integer, dimension(:), pointer :: d2g ! output + integer, dimension(:), pointer :: f2r ! output - type(tile_coord_type), dimension(:), pointer :: tile_coord ! output + type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! output - type(grid_def_type), intent(out) :: tile_grid_d + type(grid_def_type), intent(out) :: tile_grid_f + integer, dimension(:), intent(in), optional :: types ! locals integer :: n, this_tileid, this_catpfaf, N_exclude, N_include, indomain, rc - integer, dimension(N_cat_global) :: ExcludeList, IncludeList, tmp_d2g + integer, dimension(N_tile_global) :: ExcludeList, IncludeList, tmp_f2g real :: this_minlon, this_minlat, this_maxlon, this_maxlat - logical :: this_cat_exclude, this_cat_include, this_cat_in_box + logical :: this_tile_exclude, this_tile_include, this_cat_in_box integer :: this_i_indg, this_j_indg @@ -425,7 +428,8 @@ subroutine domain_setup( & character(len=*), parameter :: Iam = 'domain_setup' character(len=400) :: err_msg - + integer, allocatable, dimension(:):: tile_types + ! ------------------------------------------------------------ if (logit) write (logunit,*) 'Setting up domain: ' @@ -436,7 +440,13 @@ subroutine domain_setup( & ! try reading *domain.txt, *tilecoord.txt, and *tilegrids.txt files call io_domain_files( 'r', work_path, exp_id, & - N_cat_domain, d2g, tile_coord, tmp_grid_def, tile_grid_d, rc ) + N_tile_f, f2g, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) + + if (present(types)) then + tile_types = types + else + tile_types = [MAPL_LAND] + endif if (rc==0) then ! read was successful @@ -460,14 +470,14 @@ subroutine domain_setup( & fname = trim(exclude_path) // '/' // trim(exclude_file) - call read_exclude_or_includelist(N_cat_global, fname, ExcludeList, N_exclude) + call read_exclude_or_includelist(N_tile_global, fname, ExcludeList, N_exclude) ! load IncludeList: catchments listed in this file will be included ! (unless excluded via ExcludeList) fname = trim(include_path) // '/' // trim(include_file) - call read_exclude_or_includelist(N_cat_global, fname, IncludeList, N_include) + call read_exclude_or_includelist(N_tile_global, fname, IncludeList, N_include) ! ----------------- ! ! find and count catchments that are in the domain @@ -477,48 +487,48 @@ subroutine domain_setup( & indomain = 0 ! initialize - do n=1,N_cat_global + do n=1,N_tile_r - this_tileid = tile_coord_global(n)%tile_id + this_tileid = tile_coord_r(n)%tile_id - if( .not. c3_grid) then - this_minlon = tile_coord_global(n)%min_lon - this_minlat = tile_coord_global(n)%min_lat - this_maxlon = tile_coord_global(n)%max_lon - this_maxlat = tile_coord_global(n)%max_lat + if( .not. c3_grid .and. tile_coord_r(n)%tpy == MAPL_LAND) then + this_minlon = tile_coord_r(n)%min_lon + this_minlat = tile_coord_r(n)%min_lat + this_maxlon = tile_coord_r(n)%max_lon + this_maxlat = tile_coord_r(n)%max_lat else ! c3 grid can straddle the lat-lon - this_minlon = tile_coord_global(n)%com_lon - this_minlat = tile_coord_global(n)%com_lat - this_maxlon = tile_coord_global(n)%com_lon - this_maxlat = tile_coord_global(n)%com_lat + this_minlon = tile_coord_r(n)%com_lon + this_minlat = tile_coord_r(n)%com_lat + this_maxlon = tile_coord_r(n)%com_lon + this_maxlat = tile_coord_r(n)%com_lat endif - this_cat_exclude = is_in_list( N_exclude, ExcludeList(1:N_exclude), this_tileid ) - this_cat_include = is_in_list( N_include, IncludeList(1:N_include), this_tileid ) + this_tile_exclude = is_in_list( N_exclude, ExcludeList(1:N_exclude), this_tileid ) + this_tile_include = is_in_list( N_include, IncludeList(1:N_include), this_tileid ) this_cat_in_box = & is_cat_in_box(this_minlon,this_minlat,this_maxlon,this_maxlat, & minlon, minlat, maxlon, maxlat ) if (is_in_domain( & - this_cat_exclude, this_cat_include, this_cat_in_box )) then + this_tile_exclude, this_tile_include, this_cat_in_box )) then indomain = indomain + 1 - tmp_d2g(indomain) = n + tmp_f2r(indomain) = n end if end do - N_cat_domain = indomain + N_tile_f = indomain - if (N_cat_domain .eq. 0) then + if (N_tile_f .eq. 0) then err_msg = 'No catchments found in domain' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) else if (logit) then - write (logunit,*) 'Number of catchments in domain = ', N_cat_domain + write (logunit,*) 'Number of tiles in domain = ', N_tile_f write (logunit,*) end if end if @@ -527,27 +537,26 @@ subroutine domain_setup( & ! ! assemble d2g, tile_coord, tile_grid_d - allocate(d2g( N_cat_domain)) - allocate(tile_coord(N_cat_domain)) - - d2g(1:N_cat_domain) = tmp_d2g(1:N_cat_domain) + allocate(f2r( N_tile_f)) + allocate(tile_coord_f(N_tile_f)) - tile_coord = tile_coord_global(d2g) + f2r(1:N_tile_f) = tmp_f2r(1:N_tile_f) + tile_coord_f = tile_coord_r(f2r) ! finalize extent of actual domain: ! determine smallest subgrid of tile_grid_d that contains all ! catchments/tiles in domain - tile_grid_d = get_minExtent_grid( N_cat_domain, tile_coord%i_indg, tile_coord%j_indg, & - tile_coord%min_lon, tile_coord%min_lat, tile_coord%max_lon, tile_coord%max_lat, & + tile_grid_f = get_minExtent_grid( N_tile_f, tile_coord_f%i_indg, tile_coord_f%j_indg, & + tile_coord_f%min_lon, tile_coord_f%min_lat, tile_coord_f%max_lon, tile_coord_f%max_lat, & tile_grid_g) ! output domain files tmp_grid_def = tile_grid_g ! cannot use intent(in) tile_grid_g w/ io_domain_files - call io_domain_files( 'w', work_path, exp_id, & - N_cat_domain, d2g, tile_coord, tmp_grid_def, tile_grid_d, rc ) + !call io_domain_files( 'w', work_path, exp_id, & + ! N_tile_f, f2g, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) end if ! domain/tilecoord/tilegrids files exist @@ -562,7 +571,7 @@ subroutine domain_setup( & tmpstring40 = 'tile_grid_d' - if (logit) call io_grid_def_type('w', logunit, tile_grid_d, tmpstring40) + if (logit) call io_grid_def_type('w', logunit, tile_grid_f, tmpstring40) print*, "Done with " // trim(Iam) @@ -824,7 +833,7 @@ end function open_land_param_file ! ***************************************************************************************** subroutine read_cat_param( & - N_catg, N_catf, f2g, tile_coord_f, dzsf, veg_path, soil_path, top_path, & + N_catg, N_catf, tile_coord_f, dzsf, veg_path, soil_path, top_path, & cp ) ! Reads soil properties and topographic parameters from global files @@ -853,8 +862,6 @@ subroutine read_cat_param( & real, intent(in) :: dzsf - integer, dimension(N_catf), intent(in) :: f2g - character(*), intent(in) :: veg_path character(*), intent(in) :: soil_path character(*), intent(in) :: top_path @@ -883,7 +890,7 @@ subroutine read_cat_param( & character(len=*), parameter :: Iam = 'read_cat_param' character(len=400) :: err_msg - + real, dimension(NTYPS) :: VGZ2 ! legacy vegetation height look-up table (for backward compatibility) @@ -989,14 +996,15 @@ subroutine read_cat_param( & do k=1,N_catf ! this check works only for "SiB2_V2" and newer versions - - if (tile_coord_f(k)%tile_id/=tmptileid(f2g(k))) then + gid = tile_coord_f(k)%tile_id + if (gid /=tmptileid(gid)) then err_msg = 'something wrong with veg parameters' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if - cp(k)%vegcls = tmpint( f2g(k) ) - cp(k)%veghght = tmpreal(f2g(k),1) + cp(k)%vegcls = tmpint(gid ) + + cp(k)%veghght = tmpreal(gid,1) end do @@ -1495,18 +1503,18 @@ end subroutine createf2g ! ******************************************************************** - subroutine readsize(f2g_file, N_catg,N_catf) + subroutine readsize(mapping_file, N_catg,N_catf) implicit none - character(*), intent(in):: f2g_file + character(*), intent(in):: mapping_file integer,intent(out) :: N_catg integer,intent(out) :: N_catf logical :: file_exist - inquire(file=f2g_file,exist=file_exist) + inquire(file=mapping_file,exist=file_exist) if(file_exist) then - open(40,file= f2g_file,form='formatted',action='read',status='old') + open(40,file= mapping_file,form='formatted',action='read',status='old') read(40,*)N_catg read(40,*)N_catf close(40) @@ -1517,10 +1525,10 @@ end subroutine readsize ! ******************************************************************** - subroutine readf2g(f2g_file, N_catf,f2g) + subroutine readf2g(mapping_file, N_catf,f2g) implicit none - character(*), intent(in):: f2g_file + character(*), intent(in):: mapping_file integer,intent(in) :: N_catf integer,dimension(N_catf),intent(inout) :: f2g @@ -1528,9 +1536,9 @@ subroutine readf2g(f2g_file, N_catf,f2g) logical :: file_exist integer :: local_size,n - inquire(file=f2g_file,exist=file_exist) + inquire(file=mapping_file,exist=file_exist) if(file_exist) then - open(40,file= f2g_file,form='formatted',action='read',status='old') + open(40,file= mapping_file,form='formatted',action='read',status='old') read(40,*)N_catg read(40,*)local_size @@ -1554,59 +1562,49 @@ end subroutine readf2g ! ******************************************************************** - subroutine createLocalTilefile(f2g_file, orig_tile,new_tile) + subroutine createLocalTilefile(mapping_file, orig_tile,new_tile, tile_types) implicit none - character(*), intent(in) :: f2g_file + character(*), intent(in) :: mapping_file character(*), intent(in) :: orig_tile character(*), intent(in) :: new_tile + integer, dimension(:), optional, intent(in) :: tile_types character(len=256) :: line - character(len=3) :: MAPL_Land_STRING - character(len=4) :: MAPL_Land_ExcludeFromDomain_STRING + character(len=3) :: MAPL_TYPE_STRING(3) + character(len=4) :: MAPL_ExcludeFromDomain_STRING(3) character(len=400) :: err_msg logical :: file_exist - integer, dimension(:),allocatable :: f2g - integer :: N_catg, N_catf,n,stat, ty + integer, dimension(:),allocatable :: f2g, t_typs + integer :: N_rst_g, N_rst_f,n,stat, ty integer :: N_tile,N_grid,g_id character(len=*), parameter :: Iam = 'createLocalTilefile' - + integer, parameter :: land_ =1, lake_= 2, landice_ = 3 ! string handling below relies on MAPL_Land and MAPL_Land_ExcludeFromDomain ! falling into a certain range - ! verify that MAPL_Land has three digits - - if (MAPL_Land<100 .or. MAPL_Land>999) then - err_msg = 'string handling implemented only for 100<=MAPL_Land<=999' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - - ! verify that MAPL_Land_ExcludeFromDomain has four digits - - if (MAPL_Land_ExcludeFromDomain<1000 .or. MAPL_Land_ExcludeFromDomain>9999) then - err_msg = 'string handling implemented only for 1000<=MAPL_Land_ExcludeFromDomain<=9999' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if - ! convert integers to appropriate-length strings - - write (MAPL_Land_STRING, '(i3)') MAPL_Land - write (MAPL_Land_ExcludeFromDomain_STRING,'(i4)') MAPL_Land_ExcludeFromDomain - + MAPL_TYPE_STRING(land_) = '100' + MAPL_MAPL_ExcludeFromDomain_STRING(land_) = '1100' + MAPL_TYPE_STRING(lake_) = ' 19' + MAPL_MAPL_ExcludeFromDomain_STRING(lake_) = '1019' + MAPL_TYPE_STRING(landice_) = ' 20' + MAPL_MAPL_ExcludeFromDomain_STRING(land_ice_) = '1020' + inquire(file=trim(orig_tile),exist=file_exist) if( .not. file_exist) stop ("original tile file does not exist") ! Set default local tile file name - call readsize( f2g_file, N_catg,N_catf) - if(N_catg == N_catf) then - print*, "It is global domain..." + call readsize( mapping_file, N_tile_rst, N_tile_f) + if(N_tile_rst == N_tile_f) then ! if restart tle number is the same as the simulation tile number, no need to create small tile file + print*, "Domain is the same..." return endif allocate(f2g(N_catf)) - call readf2g(f2g_file, N_catf,f2g) + call readf2g(mapping_file, N_catf,f2g) open(40,file=trim(orig_tile),action="read") open(50,file=trim(new_tile),action="write") @@ -1638,19 +1636,29 @@ subroutine createLocalTilefile(f2g_file, orig_tile,new_tile) if(IS_IOSTAT_END(stat)) exit ! extract first "integer" in "line" and put into "ty" read(line,*) ty - if( ty == MAPL_Land ) then - ! find index where MAPL_Land ("100") starts in "line" - n=index(line,MAPL_Land_STRING) + g_id=g_id+1 + if( any( tile_types == ty)) then + + if (ty == MAPL_LAND) then + tp_ = land_ + elseif (ty == MAPL_LAKE) then + tp_ = lake_ + elseif (ty == MAPL_LANDICE) then + tp_ = landice_ + else + stop " type is not supported" + endif + + n=index(line, MAPL_TYPE_STRING(tp_)) ! make sure that a space is available in front of MAPL_Land ("100") if (n<=1) then err_msg = 'string handling requires at least one blank space in first column of *.til file' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if ! here g_id is (consecutive) id of the global *land* tiles - g_id=g_id+1 if(.not. any( f2g(:) == g_id)) then - ! if tile is not in local domain, replace " 100" in "line" with "1100" - line(n-1:n+2)=MAPL_Land_ExcludeFromDomain_STRING + ! if tile is not in local domain, replace ty in "line" with 1000+ty" + line(n-1:n+2)=MAPL_ExcludeFromDomain_STRING(tp_) endif endif ! write "line" into the output tile file @@ -1663,10 +1671,10 @@ end subroutine createLocalTilefile ! ******************************************************************** - subroutine createLocalBC(f2g_file, orig_BC, new_BC) + subroutine createLocalBC(mapping_file, orig_BC, new_BC) implicit none - character(*),intent(in) :: f2g_file + character(*),intent(in) :: mapping_file character(*),intent(in) :: orig_BC character(*),intent(in) :: new_BC @@ -1675,10 +1683,10 @@ subroutine createLocalBC(f2g_file, orig_BC, new_BC) integer :: istat, N_catg,N_catf integer,dimension(:),allocatable :: f2g - call readsize(f2g_file, N_catg,N_catf) + call readsize(mapping_file, N_catg,N_catf) if(N_catg==N_catf) return allocate(f2g(N_catf)) - call readf2g(f2g_file, N_catf,f2g) + call readf2g(mapping_file, N_catf,f2g) allocate(tmpvec(N_catg)) open(10,file=trim(orig_BC),form='unformatted',action='read',status='old',iostat=istat) @@ -1698,10 +1706,10 @@ end subroutine createLocalBC ! ******************************************************************** - subroutine createLocalCatchRestart(f2g_file, orig_catch, new_catch) + subroutine createLocalCatchRestart(mapping_file, orig_catch, new_catch) implicit none - character(*),intent(in):: f2g_file + character(*),intent(in):: mapping_file character(*),intent(in):: orig_catch character(*),intent(in):: new_catch integer,parameter :: subtile=4 @@ -1720,10 +1728,10 @@ subroutine createLocalCatchRestart(f2g_file, orig_catch, new_catch) integer ::n, N_catg,N_catf integer,dimension(:),allocatable :: f2g - call readsize(f2g_file, N_catg,N_catf) + call readsize(mapping_file, N_catg,N_catf) if(N_catg == N_catf) return allocate(f2g(N_catf)) - call readf2g(f2g_file, N_catf,f2g) + call readf2g(mapping_file, N_catf,f2g) allocate(tmp1(N_catg)) allocate(tmp2(N_catg,subtile)) @@ -1830,10 +1838,10 @@ end subroutine createLocalCatchRestart ! ******************************************************************** - subroutine createLocalmwRTMRestart(f2g_file, orig_mwrtm, new_mwrtm) + subroutine createLocalmwRTMRestart(mapping_file, orig_mwrtm, new_mwrtm) implicit none - character(*),intent(in):: f2g_file + character(*),intent(in):: mapping_file character(*),intent(in):: orig_mwrtm character(*),intent(in):: new_mwrtm integer,parameter :: subtile=4 @@ -1849,10 +1857,10 @@ subroutine createLocalmwRTMRestart(f2g_file, orig_mwrtm, new_mwrtm) integer :: N_catg,N_catf integer,dimension(:),allocatable :: f2g - call readsize(f2g_file, N_catg,N_catf) + call readsize(mapping_file, N_catg,N_catf) if(N_catg == N_catf) return allocate(f2g(N_catf)) - call readf2g(f2g_file, N_catf,f2g) + call readf2g(mapping_file, N_catf,f2g) allocate(tmp1(N_catg)) @@ -1884,10 +1892,10 @@ end subroutine createLocalmwRTMRestart ! ******************************************************************** - subroutine createLocalVegRestart(f2g_file, orig_veg, new_veg) + subroutine createLocalVegRestart(mapping_file, orig_veg, new_veg) implicit none - character(*),intent(in):: f2g_file + character(*),intent(in):: mapping_file character(*),intent(in):: orig_veg character(*),intent(in):: new_veg integer :: istat @@ -1908,10 +1916,10 @@ subroutine createLocalVegRestart(f2g_file, orig_veg, new_veg) character(len=:), pointer :: vname integer :: rc - call readsize(f2g_file, N_catg,N_catf) + call readsize(mapping_file, N_catg,N_catf) if(N_catg == N_catf) return allocate(f2g(N_catf)) - call readf2g(f2g_file, N_catf,f2g) + call readf2g(mapping_file, N_catf,f2g) allocate(rity(N_catg)) allocate(z2(N_catg)) @@ -2828,7 +2836,7 @@ end subroutine convert_pert_rst ! ************************************************************************************************** - subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_land, f2g ) + subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, r2g, N_catg, types ) ! read land tile information from *.til file ! @@ -2847,8 +2855,9 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_la ! this subroutine ! NOTE: number of *land* tiles can be diagnosed with size(tile_coord) ! optional: - ! f2g : the full domain id to the global id - ! + ! r2g : the restart domain id to the global id + ! N_catg : Number of land tiles + ! "tile_id" is no longer read from *.til file and is now set in this ! subroutine to match order of tiles in *.til file ! - reichle, 22 Aug 2013 @@ -2864,12 +2873,14 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_la character(*), intent(in) :: tile_file character(*), intent(in) :: catch_file type(grid_def_type), intent(inout):: tile_grid_g - type(tile_coord_type), dimension(:), pointer :: tile_coord_land ! out - integer, dimension(:), optional, pointer :: f2g ! out + type(tile_coord_type), dimension(:), pointer :: tile_coord_r ! out + integer, intent(out) :: N_catg + integer, dimension(:), pointer :: r2g ! out + integer, dimension(:), optional :: types ! input ! locals type(tile_coord_type), dimension(:), allocatable :: tile_coord - integer, dimension(:), allocatable :: f2g_tmp ! out + integer, dimension(:), allocatable :: r2g_tmp ! out real :: ease_cell_area integer :: i, N_tile, N_grid,tmpint1, tmpint2, tmpint3, tmpint4 @@ -2877,7 +2888,8 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_la integer :: N_tile_land, n_lon, n_lat logical :: ease_grid integer :: typ,k,fid - + integer, dimension(:), allocatable :: tile_types + character(256) :: tmpline character(128) :: gridname character(512) :: fname @@ -2889,6 +2901,12 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_la i_indg_offset = 0 j_indg_offset = 0 + if (present(types)) then + tile_types = types + else + tile_types =[MAPL_LAND] + endif + ! read *.til file header if (logit) write (logunit,'(400A)') trim(Iam), '(): reading from ' // trim(tile_file) @@ -2925,33 +2943,28 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_la if (index(tile_grid_g%gridtype,'SiB2')/=0) col_order=1 ! old bcs allocate(tile_coord(N_tile)) - allocate(f2g_tmp(N_tile)) + allocate(r2g_tmp(N_tile)) i = 0 - fid = 0 ! WJ notes: i and k are the same---global ids ! fid --- num in simulation domain - + N_catg = 0 do k=1,N_tile read(10,'(A)') tmpline read(tmpline,*) typ + if (typ == MAPL_LAND .or. typ == MAPL_LAND + MAPL_ExcludeFromDomain) N_catg = N_catg + 1 + ! tile type "MAPL_Land_ExcludeFromDomain" identifies land tiles to exclude ! when non-global domain is created - if (typ==MAPL_Land .or. typ==MAPL_Land_ExcludeFromDomain) then ! all land + if (any( tile_types == typ)) then ! all needed tiles i=i+1 tile_coord(i)%tile_id = k - - ! now keep only tiles that are not excluded by way of MAPL_Land_ExcludeFromDomain - - if (typ==MAPL_Land) then - fid=fid+1 - f2g_tmp(fid) = k - end if + r2g_tmp(i) = k ! Not sure ".or. N_grid==1" will always work in the following conditional. ! Some Tripolar grid *.til files may have N_grid=1. @@ -3028,37 +3041,38 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_la tile_coord(i)%i_indg = tile_coord(i)%i_indg + i_indg_offset tile_coord(i)%j_indg = tile_coord(i)%j_indg + j_indg_offset - else + !else ! WY note: keep reading untile the end of the file - ! exit if not land - - if (logit) then - write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' - write (logunit,*) ' Stop reading *.til file under the assumption that' - write (logunit,*) ' land tiles are first in *.til file.' - write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' - end if + ! ! exit if not land - exit ! assuming land comes first in the til file + ! if (logit) then + ! write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' + ! write (logunit,*) ' Stop reading *.til file under the assumption that' + ! write (logunit,*) ' land tiles are first in *.til file.' + ! write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' + ! end if + ! + ! exit ! assuming land comes first in the til file endif end do close(10) - - N_tile_land=i - allocate(tile_coord_land(N_tile_land)) - tile_coord_land=tile_coord(1:N_tile_land) - ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing - tile_coord_land%pert_i_indg = nint(nodata_generic) - tile_coord_land%pert_j_indg = nint(nodata_generic) - if(present(f2g)) then - allocate(f2g(fid)) - f2g = f2g_tmp(1:fid) + ! i here is the number of restart nmuber including types in 'types') + if(present(r2g)) then + allocate(r2g(i)) + r2g = r2g_tmp(1:i) endif - - call read_catchment_def( catch_file, N_tile_land, tile_coord_land ) + allocate(tile_coord_r(i)) + tile_coord_r = tile_coord(1:fid) + deallocate(tile_coord) + deallocate(r2g_tmp) + ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing + tile_coord_r%pert_i_indg = nint(nodata_generic) + tile_coord_r%pert_j_indg = nint(nodata_generic) + N_tile_land = count(tile_coord_r(:)%typ == MAPL_LAND) + call read_catchment_def( catch_file, N_tile_land, tile_coord_r ) ! ---------------------------------------------------------------------- ! @@ -3067,7 +3081,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_la ! gridded elevation file is NOT available for EASE grids, where elevation information ! is in catchment.def file - if ( abs(tile_coord_land(1)%elev-nodata_generic) Date: Wed, 17 Jul 2024 09:49:23 -0400 Subject: [PATCH 12/55] change f2g contents for other tile types --- GEOSldas_App/preprocess_ldas.F90 | 4 +- GEOSldas_App/preprocess_ldas_routines.F90 | 575 ++++++++++------------ 2 files changed, 268 insertions(+), 311 deletions(-) diff --git a/GEOSldas_App/preprocess_ldas.F90 b/GEOSldas_App/preprocess_ldas.F90 index 4d5725e6..a2dbc6fa 100644 --- a/GEOSldas_App/preprocess_ldas.F90 +++ b/GEOSldas_App/preprocess_ldas.F90 @@ -5,7 +5,7 @@ program main use preprocess_ldas_routines, ONLY: & - createf2g, & + create_mapping, & createLocalTilefile, & createLocalBC, & createLocalVegRestart, & @@ -71,7 +71,7 @@ program main SURFLAY = trim(adjustl(arg7)) f2g_file = arg8 - call createf2g(orig_tile,domain_def_file,trim(out_path),catch_def_file,trim(exp_id),ymdhm, SURFLAY, f2g_file) + call create_mapping(orig_tile,domain_def_file,trim(out_path),catch_def_file,trim(exp_id),ymdhm, SURFLAY, f2g_file) else if (trim(option) == "c_localtile") then diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 1409de2d..ada76036 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -85,7 +85,7 @@ module preprocess_ldas_routines private - public :: createf2g + public :: create_mapping public :: createLocalTilefile public :: createLocalBC public :: createLocalCatchRestart @@ -111,7 +111,7 @@ module preprocess_ldas_routines ! ******************************************************************** - subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, SURFLAY, mapping_file, types) + subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, SURFLAY, mapping_file, types) implicit none character(*) :: orig_tile @@ -131,16 +131,14 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, logical :: file_exist logical :: d_exist,c_exist - integer :: n - - type(grid_def_type) :: tile_grid_g,tile_grid_r + type(grid_def_type) :: tile_grid_g,tile_grid_f type(tile_coord_type), dimension(:), pointer :: tile_coord_r => null() type(tile_coord_type), dimension(:), pointer :: tile_coord_f => null() integer, dimension(:), pointer :: f2r => null() integer, dimension(:), pointer :: r2g => null() ! restart domain to global - integer :: N_catg, N_types,n1,n2,N_catf + integer :: N_catg, N_types, n, n1, N_catf integer, allocatable, dimension(:) :: tile_types - integer, allocatable, dimension(:) :: N_tiles_restart, N_tiles_simulation + integer, allocatable, dimension(:) :: N_tiles_r, N_tiles_f type(cat_param_type), dimension(:), allocatable :: cp real :: dzsf @@ -167,9 +165,7 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, tile_types = [MAPL_LAND] endif - call LDAS_read_til_file(orig_tile,catch_def_file, tile_grid_g, tile_coord_r, N_catg, r2g, types) - - N_tiles_r=size(tile_coord_r) + call LDAS_read_til_file(orig_tile,catch_def_file, tile_grid_g, tile_coord_r, r2g, N_catg, types) ! include and exclude files are absolute if(d_exist) then @@ -186,15 +182,15 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, endif call domain_setup( & - N_tiles_r, tile_coord_r, & + tile_coord_r, & tile_grid_g, & ' ', exclude_file, ' ', include_file, & trim(out_path), 'exp_domain ', trim(exp_id), & minlon, minlat, maxlon, maxlat, & - N_tiles_f, f2r, tile_coord_f, & + f2r, tile_coord_f, & tile_grid_f) - N_catf = count(tile_coord_f(:)%tpy == MAPL_LAND) + N_catf = count(tile_coord_f(:)%typ == MAPL_LAND) allocate(cp(N_catf)) @@ -207,23 +203,19 @@ subroutine createf2g(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, call write_cat_param(cp,N_catf) N_types = size(tile_types) - allocate(N_tiles_restarts(N_types), N_tiles_simulations(N_types)) + allocate(N_tiles_r(N_types), N_tiles_f(N_types)) do n=1, N_types - N_tiles_restarts(n) = count(tilecoord_r%typ == tile_types(n)) - N_tiles_simulations(n) = count(tilecoord_f%typ == tile_types(n)) + N_tiles_r(n) = count(tile_coord_r%typ == tile_types(n)) + N_tiles_f(n) = count(tile_coord_f%typ == tile_types(n)) enddo open(40,file=mapping_file,form='formatted',action='write') write(40,*)N_types - write(40,*)N_tiles_restarts ! length N_types - write(40,*)N_tiles_simulations ! length N_types - - do n=1,N_tiles_f - write(40,*)f2r(n) - enddo - do n=1,N_files_r - write(40,*)r2g(n) - enddo + write(40,*)tile_types + write(40,*)N_tiles_r ! length N_types + write(40,*)N_tiles_f ! length N_types + write(40,*)f2r + write(40,*)r2g close(40) if (associated(f2r)) deallocate(f2r) if (associated(r2g)) deallocate(r2g) @@ -329,12 +321,12 @@ end function is_cat_in_box ! ******************************************************************** subroutine domain_setup( & - N_tile_r, tile_coord_r, & + tile_coord_r, & tile_grid_g, & exclude_path, exclude_file, include_path, include_file, & work_path, exp_domain, exp_id, & minlon, minlat, maxlon, maxlat, & - N_tile_f, f2r, tile_coord_f, tile_grid_f, types ) + f2r, tile_coord_f, tile_grid_f, types ) ! Set up modeling domain and determine index vectors mapping from the ! domain to global catchment space. @@ -385,10 +377,7 @@ subroutine domain_setup( & implicit none - integer, intent(in) :: N_tile_r - type(tile_coord_type), dimension(:), pointer :: tile_coord_r ! input - type(grid_def_type), intent(in) :: tile_grid_g character(*), intent(in) :: exclude_path, include_path @@ -401,8 +390,6 @@ subroutine domain_setup( & real, intent(in) :: minlon, minlat ! from nml inputs real, intent(in) :: maxlon, maxlat ! from nml inputs - integer, intent(out) :: N_tile_f - integer, dimension(:), pointer :: f2r ! output type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! output @@ -412,9 +399,9 @@ subroutine domain_setup( & ! locals - integer :: n, this_tileid, this_catpfaf, N_exclude, N_include, indomain, rc + integer :: n, this_tileid, this_catpfaf, N_exclude, N_include, indomain, rc, N_tile_r, N_tile_f - integer, dimension(N_tile_global) :: ExcludeList, IncludeList, tmp_f2g + integer, dimension(:), allocatable :: ExcludeList, IncludeList real :: this_minlon, this_minlat, this_maxlon, this_maxlat @@ -428,7 +415,7 @@ subroutine domain_setup( & character(len=*), parameter :: Iam = 'domain_setup' character(len=400) :: err_msg - integer, allocatable, dimension(:):: tile_types + integer, allocatable, dimension(:):: tile_types, tmp_f2r ! ------------------------------------------------------------ @@ -439,9 +426,9 @@ subroutine domain_setup( & ! ! try reading *domain.txt, *tilecoord.txt, and *tilegrids.txt files - call io_domain_files( 'r', work_path, exp_id, & - N_tile_f, f2g, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) - + !call io_domain_files( 'r', work_path, exp_id, & + ! N_tile_f, f2g, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) + rc = -1 if (present(types)) then tile_types = types else @@ -469,15 +456,15 @@ subroutine domain_setup( & ! load ExcludeList: catchments listed in this file will *always* be excluded fname = trim(exclude_path) // '/' // trim(exclude_file) - - call read_exclude_or_includelist(N_tile_global, fname, ExcludeList, N_exclude) + + call read_exclude_or_includelist(fname, ExcludeList) ! load IncludeList: catchments listed in this file will be included ! (unless excluded via ExcludeList) fname = trim(include_path) // '/' // trim(include_file) - call read_exclude_or_includelist(N_tile_global, fname, IncludeList, N_include) + call read_exclude_or_includelist(fname, IncludeList) ! ----------------- ! ! find and count catchments that are in the domain @@ -486,12 +473,14 @@ subroutine domain_setup( & if(index(tile_grid_g%gridtype,"c3")/=0) c3_grid = .true. indomain = 0 ! initialize - + + N_tile_r = size(tile_coord_r) + allocate(tmp_f2r(N_tile_r)) do n=1,N_tile_r this_tileid = tile_coord_r(n)%tile_id - if( .not. c3_grid .and. tile_coord_r(n)%tpy == MAPL_LAND) then + if( .not. c3_grid .and. tile_coord_r(n)%typ == MAPL_LAND) then this_minlon = tile_coord_r(n)%min_lon this_minlat = tile_coord_r(n)%min_lat this_maxlon = tile_coord_r(n)%max_lon @@ -503,7 +492,8 @@ subroutine domain_setup( & this_maxlat = tile_coord_r(n)%com_lat endif - + N_exclude = size(ExcludeList) + N_include = size(IncludeList) this_tile_exclude = is_in_list( N_exclude, ExcludeList(1:N_exclude), this_tileid ) this_tile_include = is_in_list( N_include, IncludeList(1:N_include), this_tileid ) @@ -560,13 +550,13 @@ subroutine domain_setup( & end if ! domain/tilecoord/tilegrids files exist - ! output extent of domain and tile_grid_d to logunit + ! output extent of domain and tile_grid_f to logunit if (logit) write (logunit,*) 'Actual extent of domain grid:' - if (logit) write (logunit,*) 'min lon = ', tile_grid_d%ll_lon - if (logit) write (logunit,*) 'max lon = ', tile_grid_d%ur_lon - if (logit) write (logunit,*) 'min lat = ', tile_grid_d%ll_lat - if (logit) write (logunit,*) 'max lat = ', tile_grid_d%ur_lat + if (logit) write (logunit,*) 'min lon = ', tile_grid_f%ll_lon + if (logit) write (logunit,*) 'max lon = ', tile_grid_f%ur_lon + if (logit) write (logunit,*) 'min lat = ', tile_grid_f%ll_lat + if (logit) write (logunit,*) 'max lat = ', tile_grid_f%ur_lat if (logit) write (logunit,*) tmpstring40 = 'tile_grid_d' @@ -579,7 +569,7 @@ end subroutine domain_setup ! ************************************************************************* - subroutine read_exclude_or_includelist(N_cat, fname, MyList, N_list) + subroutine read_exclude_or_includelist(fname, MyList) ! read numbers/IDs of catchments in MyList (ExcludeList or IncludeList) ! @@ -593,19 +583,12 @@ subroutine read_exclude_or_includelist(N_cat, fname, MyList, N_list) implicit none - ! N_cat = max number of catchments allowed in list - ! (use N_cat_global when calling this subroutine) - - integer, intent(in) :: N_cat character(*), intent(in) :: fname - - integer, intent(out) :: N_list - - integer, dimension(N_cat), intent(out) :: MyList + integer, dimension(:), allocatable, intent(out) :: MyList ! locals - integer :: istat, tmpint + integer :: istat, i, N_list logical :: file_exists @@ -619,44 +602,29 @@ subroutine read_exclude_or_includelist(N_cat, fname, MyList, N_list) inquire( file=fname, exist=file_exists) if (file_exists) then - + N_list = 0 + OPEN (10, file = fname) + if (logit) write (logunit,*) & + 'reading ExcludeList or IncludeList from ', trim(fname) + if (logit) write (logunit,*) + DO + READ(10,*,iostat=istat) + IF (istat/=0) EXIT + N_list = N_list+1 + END DO + CLOSE (10) + + if (allocated(MyList)) deallocate(MyList) + allocate(MyList(N_List)) + open(10, file=fname, form='formatted', action='read', & status='old', iostat=istat) if (istat==0) then - - if (logit) write (logunit,*) & - 'reading ExcludeList or IncludeList from ', trim(fname) - if (logit) write (logunit,*) - - do - read(10,*,iostat=istat) tmpint - - if (istat==-1) then - if (logit) write (logunit,*) ' found ', N_list, ' catchments on list' - exit - else if (istat/=0) then - err_msg = 'read error other than end-of-file' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - else - N_list = N_list+1 - MyList(N_list) = tmpint - end if - - if (N_list>N_cat) then - - write (tmpstring10,*) N_cat - write (tmpstring40,*) N_list - - err_msg = 'N_list=' // trim(tmpstring40) & - // ' > N_cat=' // trim(tmpstring10) - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - - end if + do i = 1, N_list + read(10,*,iostat=istat) MyList(i) end do - close(10,status='keep') - else if (logit) write (logunit,*) & @@ -665,10 +633,12 @@ subroutine read_exclude_or_includelist(N_cat, fname, MyList, N_list) end if else + if (allocated(MyList)) deallocate(MyList) + allocate(MyList(0)) if (logit) write (logunit,*) & 'ExcludeList or IncludeList file does not exist: ', trim(fname) - + end if if (logit) write (logunit,*) @@ -878,7 +848,7 @@ subroutine read_cat_param( & character(100), dimension(N_search_dir_max) :: search_dir - integer :: n, k, m, dummy_int, dummy_int2, istat, N_search_dir, N_col + integer :: n, k, m, dummy_int, dummy_int2, istat, N_search_dir, N_col, gid integer, dimension(N_catg) :: tmpint, tmpint2, tmptileid @@ -1062,21 +1032,21 @@ subroutine read_cat_param( & if (logit) write (logunit,*) do k=1,N_catf - - if (tile_coord_f(k)%tile_id/=tmptileid(f2g(k))) then + gid = tile_coord_f(k)%tile_id + if (tile_coord_f(k)%tile_id/=tmptileid(gid)) then err_msg = 'something wrong with soil parameters' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if - cp(k)%bee = tmpreal(f2g(k),1) - cp(k)%psis = tmpreal(f2g(k),2) - cp(k)%poros = tmpreal(f2g(k),3) - cp(k)%cond = tmpreal(f2g(k),4) - cp(k)%wpwet = tmpreal(f2g(k),5) - cp(k)%dpth = tmpreal(f2g(k),6) + cp(k)%bee = tmpreal(gid,1) + cp(k)%psis = tmpreal(gid,2) + cp(k)%poros = tmpreal(gid,3) + cp(k)%cond = tmpreal(gid,4) + cp(k)%wpwet = tmpreal(gid,5) + cp(k)%dpth = tmpreal(gid,6) - cp(k)%soilcls30 = tmpint( f2g(k)) - cp(k)%soilcls100 = tmpint2(f2g(k)) + cp(k)%soilcls30 = tmpint( gid) + cp(k)%soilcls100 = tmpint2(gid) end do @@ -1094,16 +1064,16 @@ subroutine read_cat_param( & ! "Icarus-NLv4" has 20 columns (new, last column is peat fraction, ignore for now) do k=1,N_catf - - cp(k)%gravel30 = tmpreal(f2g(k), 7) - cp(k)%orgC30 = tmpreal(f2g(k), 8) - cp(k)%orgC = tmpreal(f2g(k), 9) - cp(k)%sand30 = tmpreal(f2g(k),10) - cp(k)%clay30 = tmpreal(f2g(k),11) - cp(k)%sand = tmpreal(f2g(k),12) - cp(k)%clay = tmpreal(f2g(k),13) - cp(k)%wpwet30 = tmpreal(f2g(k),14) - cp(k)%poros30 = tmpreal(f2g(k),15) + gid = tile_coord_f(k)%tile_id + cp(k)%gravel30 = tmpreal(gid, 7) + cp(k)%orgC30 = tmpreal(gid, 8) + cp(k)%orgC = tmpreal(gid, 9) + cp(k)%sand30 = tmpreal(gid,10) + cp(k)%clay30 = tmpreal(gid,11) + cp(k)%sand = tmpreal(gid,12) + cp(k)%clay = tmpreal(gid,13) + cp(k)%wpwet30 = tmpreal(gid,14) + cp(k)%poros30 = tmpreal(gid,15) end do @@ -1154,8 +1124,8 @@ subroutine read_cat_param( & do k=1,N_catf ! this check works only for "SiB2_V2" version - - if (tile_coord_f(k)%tile_id/=tmptileid(f2g(k))) then + gid = tile_coord_f(k)%tile_id + if (tile_coord_f(k)%tile_id/=tmptileid(gid)) then err_msg = 'something wrong with tau parameters' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if @@ -1164,13 +1134,13 @@ subroutine read_cat_param( & if (abs(dzsf-20.)<1e-4 ) then ! use atau2, btau2 - cp(k)%atau = tmpreal(f2g(k),1) - cp(k)%btau = tmpreal(f2g(k),2) + cp(k)%atau = tmpreal(gid,1) + cp(k)%btau = tmpreal(gid,2) elseif (abs(dzsf-50.)<1e-4 ) then ! use atau5, btau5 - cp(k)%atau = tmpreal(f2g(k),3) - cp(k)%btau = tmpreal(f2g(k),4) + cp(k)%atau = tmpreal(gid,3) + cp(k)%btau = tmpreal(gid,4) else @@ -1222,24 +1192,24 @@ subroutine read_cat_param( & do k=1,N_catf ! this check works only for "SiB2_V2" version - - if (tile_coord_f(k)%tile_id/=tmptileid(f2g(k))) then + gid = tile_coord_f(k)%tile_id + if (tile_coord_f(k)%tile_id/=tmptileid(gid)) then err_msg = 'something wrong with ar parameters' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if - cp(k)%gnu = tmpreal(f2g(k),1) - cp(k)%ars1 = tmpreal(f2g(k),2) - cp(k)%ars2 = tmpreal(f2g(k),3) - cp(k)%ars3 = tmpreal(f2g(k),4) - cp(k)%ara1 = tmpreal(f2g(k),5) - cp(k)%ara2 = tmpreal(f2g(k),6) - cp(k)%ara3 = tmpreal(f2g(k),7) - cp(k)%ara4 = tmpreal(f2g(k),8) - cp(k)%arw1 = tmpreal(f2g(k),9) - cp(k)%arw2 = tmpreal(f2g(k),10) - cp(k)%arw3 = tmpreal(f2g(k),11) - cp(k)%arw4 = tmpreal(f2g(k),12) + cp(k)%gnu = tmpreal(gid,1) + cp(k)%ars1 = tmpreal(gid,2) + cp(k)%ars2 = tmpreal(gid,3) + cp(k)%ars3 = tmpreal(gid,4) + cp(k)%ara1 = tmpreal(gid,5) + cp(k)%ara2 = tmpreal(gid,6) + cp(k)%ara3 = tmpreal(gid,7) + cp(k)%ara4 = tmpreal(gid,8) + cp(k)%arw1 = tmpreal(gid,9) + cp(k)%arw2 = tmpreal(gid,10) + cp(k)%arw3 = tmpreal(gid,11) + cp(k)%arw4 = tmpreal(gid,12) end do @@ -1270,21 +1240,21 @@ subroutine read_cat_param( & do k=1,N_catf ! this check works only for "SiB2_V2" version - - if (tile_coord_f(k)%tile_id/=tmptileid(f2g(k))) then + gid = tile_coord_f(k)%tile_id + if (tile_coord_f(k)%tile_id/=tmptileid(gid)) then err_msg = 'something wrong with bf parameters' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if ! --------- - if (cp(k)%gnu/=tmpreal(f2g(k),1)) then + if (cp(k)%gnu/=tmpreal(gid, 1)) then err_msg = 'land(): something wrong with gnu' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if - cp(k)%bf1 = tmpreal(f2g(k),2) - cp(k)%bf2 = tmpreal(f2g(k),3) - cp(k)%bf3 = tmpreal(f2g(k),4) + cp(k)%bf1 = tmpreal(gid, 2) + cp(k)%bf2 = tmpreal(gid, 3) + cp(k)%bf3 = tmpreal(gid, 4) end do @@ -1315,21 +1285,22 @@ subroutine read_cat_param( & ! this check works only for "SiB2_V2" version - if (tile_coord_f(k)%tile_id/=tmptileid(f2g(k))) then + gid = tile_coord_f(k)%tile_id + if (tile_coord_f(k)%tile_id/=tmptileid(gid)) then err_msg = 'something wrong with ts parameters' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if ! ------- - if (cp(k)%gnu/=tmpreal(f2g(k),1)) then + if (cp(k)%gnu/=tmpreal(gid,1)) then err_msg = 'land(): something wrong with gnu' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if - cp(k)%tsa1 = tmpreal(f2g(k),2) - cp(k)%tsa2 = tmpreal(f2g(k),3) - cp(k)%tsb1 = tmpreal(f2g(k),4) - cp(k)%tsb2 = tmpreal(f2g(k),5) + cp(k)%tsa1 = tmpreal(gid,2) + cp(k)%tsa2 = tmpreal(gid,3) + cp(k)%tsb1 = tmpreal(gid,4) + cp(k)%tsb2 = tmpreal(gid,5) end do @@ -1499,113 +1470,96 @@ subroutine write_cat_param(cat_param, N_catd) end subroutine write_cat_param - end subroutine createf2g + end subroutine create_mapping ! ******************************************************************** - subroutine readsize(mapping_file, N_catg,N_catf) + subroutine read_mapping(mapping_file, N_types, tile_types, N_tiles_r, N_tiles_f, f2r, r2g) implicit none character(*), intent(in):: mapping_file - integer,intent(out) :: N_catg - integer,intent(out) :: N_catf + integer, intent(out) :: N_types + integer, dimension(:), allocatable, optional, intent(out) :: tile_types + integer, dimension(:), allocatable, optional, intent(out) :: N_tiles_r + integer, dimension(:), allocatable, optional, intent(out) :: N_tiles_f + integer, dimension(:), allocatable, optional, intent(out) :: f2r + integer, dimension(:), allocatable, optional, intent(out) :: r2g logical :: file_exist - - inquire(file=mapping_file,exist=file_exist) - if(file_exist) then - open(40,file= mapping_file,form='formatted',action='read',status='old') - read(40,*)N_catg - read(40,*)N_catf - close(40) - else - print*, " wrong, no f2g.txt" - endif - end subroutine readsize - - ! ******************************************************************** - - subroutine readf2g(mapping_file, N_catf,f2g) - - implicit none - character(*), intent(in):: mapping_file - integer,intent(in) :: N_catf - integer,dimension(N_catf),intent(inout) :: f2g - - integer :: N_catg - logical :: file_exist - integer :: local_size,n - + integer, dimension(:), allocatable :: N_tiles_r_tmp, N_tiles_f_tmp + inquire(file=mapping_file,exist=file_exist) if(file_exist) then open(40,file= mapping_file,form='formatted',action='read',status='old') - read(40,*)N_catg - read(40,*)local_size - - if(local_size /= N_catf) print*, "wrong f2g.txt" - - if(N_catg == N_catf) then - close(40) - return + read(40,*)N_types + allocate(N_tiles_r_tmp(N_types)) + allocate(N_tiles_f_tmp(N_types)) + + if (present(tile_types)) then + allocate(tile_types(N_types)) + read(40,*) tile_types + else + read(40,*) ! read off tile_types + endif + + read(40,*) N_tiles_r_tmp + read(40,*) N_tiles_f_tmp + + if (present(f2r)) then + allocate(f2r(sum(N_tiles_f_tmp))) + read(40,*) f2r + else + read(40,*)! read off f2r + endif + if (present(r2g)) then + allocate(r2g(sum(N_tiles_r_tmp))) + read(40,*) r2g + else + read(40,*)! read off r2g endif - do n=1,N_catf - read(40,*)f2g(n) - enddo + if (present(N_tiles_r)) N_tiles_r = N_tiles_r_tmp + if (present(N_tiles_f)) N_tiles_f = N_tiles_f_tmp + close(40) - ! call MAPL_sort(this%f2g) else - print*, " wrong, no f2g.txt" + print*, " wrong, no mapping file" endif - - end subroutine readf2g + end subroutine read_mapping ! ******************************************************************** - subroutine createLocalTilefile(mapping_file, orig_tile,new_tile, tile_types) + subroutine createLocalTilefile(mapping_file, orig_tile, new_tile) implicit none character(*), intent(in) :: mapping_file character(*), intent(in) :: orig_tile character(*), intent(in) :: new_tile - integer, dimension(:), optional, intent(in) :: tile_types character(len=256) :: line - character(len=3) :: MAPL_TYPE_STRING(3) - character(len=4) :: MAPL_ExcludeFromDomain_STRING(3) - character(len=400) :: err_msg logical :: file_exist - integer, dimension(:),allocatable :: f2g, t_typs - integer :: N_rst_g, N_rst_f,n,stat, ty - integer :: N_tile,N_grid,g_id - - character(len=*), parameter :: Iam = 'createLocalTilefile' - integer, parameter :: land_ =1, lake_= 2, landice_ = 3 - ! string handling below relies on MAPL_Land and MAPL_Land_ExcludeFromDomain - ! falling into a certain range - - ! convert integers to appropriate-length strings - MAPL_TYPE_STRING(land_) = '100' - MAPL_MAPL_ExcludeFromDomain_STRING(land_) = '1100' - MAPL_TYPE_STRING(lake_) = ' 19' - MAPL_MAPL_ExcludeFromDomain_STRING(lake_) = '1019' - MAPL_TYPE_STRING(landice_) = ' 20' - MAPL_MAPL_ExcludeFromDomain_STRING(land_ice_) = '1020' + integer, dimension(:),allocatable :: f2g, f2r,r2g, tile_types, N_tiles_r, N_tiles_f + + integer :: n,stat, ty, N_types + integer :: N_tile, N_grid, g_id, f_id + + character(len=4) :: typ_str, typ_str_exclude + + character(len=*), parameter :: Iam = 'createLocalTilefile' + inquire(file=trim(orig_tile),exist=file_exist) if( .not. file_exist) stop ("original tile file does not exist") ! Set default local tile file name - call readsize( mapping_file, N_tile_rst, N_tile_f) - if(N_tile_rst == N_tile_f) then ! if restart tle number is the same as the simulation tile number, no need to create small tile file - print*, "Domain is the same..." + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) + if( all(N_tiles_r == N_tiles_f)) then + print*, "Domain is the same, no need to create tile file..." return endif - allocate(f2g(N_catf)) - call readf2g(mapping_file, N_catf,f2g) - + open(40,file=trim(orig_tile),action="read") open(50,file=trim(new_tile),action="write") @@ -1629,40 +1583,31 @@ subroutine createLocalTilefile(mapping_file, orig_tile,new_tile, tile_types) enddo endif - g_id = 0 + g_id = 1 + f_id = 1 + f2g = r2g(f2r) do while(.true.) ! read one line of *.til file read(40,'(A)',IOSTAT=stat) line if(IS_IOSTAT_END(stat)) exit ! extract first "integer" in "line" and put into "ty" read(line,*) ty - g_id=g_id+1 if( any( tile_types == ty)) then - - if (ty == MAPL_LAND) then - tp_ = land_ - elseif (ty == MAPL_LAKE) then - tp_ = lake_ - elseif (ty == MAPL_LANDICE) then - tp_ = landice_ - else - stop " type is not supported" - endif - - n=index(line, MAPL_TYPE_STRING(tp_)) - ! make sure that a space is available in front of MAPL_Land ("100") - if (n<=1) then - err_msg = 'string handling requires at least one blank space in first column of *.til file' - call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) - end if ! here g_id is (consecutive) id of the global *land* tiles - if(.not. any( f2g(:) == g_id)) then + if (f2g(f_id) /= g_id) then ! if tile is not in local domain, replace ty in "line" with 1000+ty" - line(n-1:n+2)=MAPL_ExcludeFromDomain_STRING(tp_) + write(typ_str, '(I0)') ty + typ_str = adjustr(typ_str) + n=index(line, typ_str) + write(typ_str_exclude, '(I0)') ty + MAPL_ExcludeFromDomain + line(n:n+3) = typ_str_exclude + else + f_id = f_id + 1 endif endif ! write "line" into the output tile file write(50,'(A)') trim(line) + g_id = g_id+1 enddo close(40) close(50) @@ -1680,15 +1625,17 @@ subroutine createLocalBC(mapping_file, orig_BC, new_BC) real,dimension(14) :: tmprealvec14 real,allocatable :: tmpvec(:) - integer :: istat, N_catg,N_catf - integer,dimension(:),allocatable :: f2g - - call readsize(mapping_file, N_catg,N_catf) - if(N_catg==N_catf) return - allocate(f2g(N_catf)) - call readf2g(mapping_file, N_catf,f2g) + integer :: istat, N_catr, N_catf, N_types + integer,dimension(:),allocatable :: f2r_land, f2r, r2g, tile_types, N_tiles_r, N_tiles_f + + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) + if (tile_types(1) /= MAPL_LAND) return + if (N_tiles_r(1) == N_tiles_f(1) ) return + N_catf = N_tiles_f(1) + N_catr = N_tiles_r(1) + f2r_land = f2r(1:N_catf) - allocate(tmpvec(N_catg)) + allocate(tmpvec(N_catr)) open(10,file=trim(orig_BC),form='unformatted',action='read',status='old',iostat=istat) open(20,file=trim(new_BC),form='unformatted',action='write') @@ -1697,7 +1644,7 @@ subroutine createLocalBC(mapping_file, orig_BC, new_BC) if(IS_IOSTAT_END(istat)) exit read(10) tmpvec write(20) tmprealvec14 - write(20) tmpvec(f2g) + write(20) tmpvec(f2r_land) enddo close(10) close(20) @@ -1725,16 +1672,19 @@ subroutine createLocalCatchRestart(mapping_file, orig_catch, new_catch) type(StringVariableMapIterator) :: var_iter type(StringVector), pointer :: var_dimensions character(len=:), pointer :: vname,dname - integer ::n, N_catg,N_catf - integer,dimension(:),allocatable :: f2g - - call readsize(mapping_file, N_catg,N_catf) - if(N_catg == N_catf) return - allocate(f2g(N_catf)) - call readf2g(mapping_file, N_catf,f2g) - - allocate(tmp1(N_catg)) - allocate(tmp2(N_catg,subtile)) + integer ::n, N_catr, N_catf, N_types + integer,dimension(:),allocatable :: f2r, r2g, f2r_land, tile_types, N_tiles_r, N_tiles_f + + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) + if (tile_types(1) /= MAPL_LAND) return + if (N_tiles_r(1) == N_tiles_f(1) ) return + N_catf = N_tiles_f(1) + N_catr = N_tiles_r(1) + + f2r_land = f2r(1:N_catf) + + allocate(tmp1(N_catr)) + allocate(tmp2(N_catr,subtile)) ! check file type @@ -1751,26 +1701,26 @@ subroutine createLocalCatchRestart(mapping_file, orig_catch, new_catch) do n=1,30 read(10) tmp1 - write(20) tmp1(f2g) + write(20) tmp1(f2r_land) enddo do n=1,2 read(10) tmp2 - write(20) tmp2(f2g,:) + write(20) tmp2(f2r_land,:) enddo do n=1,20 read(10) tmp1 - write(20) tmp1(f2g) + write(20) tmp1(f2r_land) enddo ! note : the offline restart does not have the last five variables do n=1,4 read(10,iostat=istat) tmp2 - if(.not. IS_IOSTAT_END(istat)) write(20) tmp2(f2g,:) + if(.not. IS_IOSTAT_END(istat)) write(20) tmp2(f2r_land,:) enddo ! 57 WW read(10,iostat=istat) tmp2 - if(.not. IS_IOSTAT_END(istat)) write(20) tmp2(f2g,:) + if(.not. IS_IOSTAT_END(istat)) write(20) tmp2(f2r_land,:) close(10) close(20) @@ -1782,7 +1732,7 @@ subroutine createLocalCatchRestart(mapping_file, orig_catch, new_catch) InCfg = InFmt%read(rc=rc) OutCfg = InCfg - call OutCfg%modify_dimension('tile', size(f2g), rc=rc) + call OutCfg%modify_dimension('tile', size(f2r_land), rc=rc) call OutFmt%create(trim(new_catch),rc=rc) call OutFmt%write(OutCfg,rc=rc) @@ -1804,14 +1754,14 @@ subroutine createLocalCatchRestart(mapping_file, orig_catch, new_catch) if (ndims == 1) then call MAPL_VarRead (InFmt,vname,tmp1) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2g)) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_land)) else if (ndims == 2) then dname => var%get_ith_dimension(2) dim1=InCfg%get_dimension(dname) do j=1,dim1 call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2g),offset1=j) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_land),offset1=j) enddo else if (ndims == 3) then @@ -1823,7 +1773,7 @@ subroutine createLocalCatchRestart(mapping_file, orig_catch, new_catch) do i=1,dim2 do j=1,dim1 call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j,offset2=i) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2g) ,offset1=j,offset2=i) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_land) ,offset1=j,offset2=i) enddo enddo @@ -1854,22 +1804,25 @@ subroutine createLocalmwRTMRestart(mapping_file, orig_mwrtm, new_mwrtm) type(StringVariableMap), pointer :: variables type(StringVariableMapIterator) :: var_iter character(len=:), pointer :: vname - integer :: N_catg,N_catf - integer,dimension(:),allocatable :: f2g - - call readsize(mapping_file, N_catg,N_catf) - if(N_catg == N_catf) return - allocate(f2g(N_catf)) - call readf2g(mapping_file, N_catf,f2g) - - allocate(tmp1(N_catg)) + integer :: N_catr, N_catf, N_types + integer,dimension(:),allocatable :: f2r, r2g, f2r_land, tile_types, N_tiles_r, N_tiles_f + + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) + if (tile_types(1) /= MAPL_LAND) return + if (N_tiles_r(1) == N_tiles_f(1) ) return + N_catf = N_tiles_f(1) + N_catr = N_tiles_r(1) + + f2r_land = f2r(1:N_catf) + + allocate(tmp1(N_catr)) ! nc4 in and out file will also be nc4 call InFmt%open(trim(orig_mwrtm), pFIO_READ,rc=rc) InCfg = InFmt%read(rc=rc) OutCfg = InCfg - call OutCfg%modify_dimension('tile', size(f2g), rc=rc) + call OutCfg%modify_dimension('tile', N_catf, rc=rc) call OutFmt%create(trim(new_mwrtm),rc=rc) call OutFmt%write(OutCfg,rc=rc) @@ -1879,15 +1832,13 @@ subroutine createLocalmwRTMRestart(mapping_file, orig_mwrtm, new_mwrtm) do while (var_iter /= variables%end()) vname => var_iter%key() call MAPL_VarRead (InFmt,vname,tmp1) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2g)) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_land)) call var_iter%next() enddo call inFmt%close(rc=rc) call OutFmt%close(rc=rc) - deallocate(f2g,tmp1) - end subroutine createLocalmwRTMRestart ! ******************************************************************** @@ -1904,8 +1855,9 @@ subroutine createLocalVegRestart(mapping_file, orig_veg, new_veg) real,allocatable :: ascatz0(:) real,allocatable :: tmp(:) - integer :: N_catg,N_catf - integer,dimension(:),allocatable :: f2g + integer :: N_catr, N_catf, N_types + integer,dimension(:),allocatable :: f2r, r2g, f2r_land, tile_types, N_tiles_r, N_tiles_f + integer :: filetype type(Netcdf4_FileFormatter) :: InFmt,OutFmt type(FileMetadata) :: OutCfg @@ -1916,15 +1868,19 @@ subroutine createLocalVegRestart(mapping_file, orig_veg, new_veg) character(len=:), pointer :: vname integer :: rc - call readsize(mapping_file, N_catg,N_catf) - if(N_catg == N_catf) return - allocate(f2g(N_catf)) - call readf2g(mapping_file, N_catf,f2g) - - allocate(rity(N_catg)) - allocate(z2(N_catg)) - allocate(ascatz0(N_catg)) + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) + + if (tile_types(1) /= MAPL_LAND) return + if (N_tiles_r(1) == N_tiles_f(1) ) return + N_catf = N_tiles_f(1) + N_catr = N_tiles_r(1) + + allocate(rity(N_catr)) + allocate(z2(N_catr)) + allocate(ascatz0(N_catr)) + f2r_land = f2r(1:N_catf) + call MAPL_NCIOGetFileType(orig_veg, filetype,rc=rc) if (filetype /=0) then @@ -1933,9 +1889,9 @@ subroutine createLocalVegRestart(mapping_file, orig_veg, new_veg) read(10) rity read(10) z2 read(10) ascatz0 - write(20) rity(f2g) - write(20) z2(f2g) - write(20) ascatz0(f2g) + write(20) rity(f2r_land) + write(20) z2(f2r_land) + write(20) ascatz0(f2r_land) close(10) close(20) @@ -1945,18 +1901,18 @@ subroutine createLocalVegRestart(mapping_file, orig_veg, new_veg) InCfg = InFmt%read(rc=rc) OutCfg = InCfg - call OutCfg%modify_dimension('tile', size(f2g), rc=rc) + call OutCfg%modify_dimension('tile', N_catf, rc=rc) call OutFmt%create(trim(new_veg),rc=rc) call OutFmt%write(OutCfg,rc=rc) variables => InCfg%get_variables() var_iter = variables%begin() - allocate(tmp(N_catg)) + allocate(tmp(N_catr)) do while (var_iter /= variables%end()) vname => var_iter%key() call MAPL_VarRead (InFmt,vname,tmp) - call MAPL_VarWrite(OutFmt,vname,tmp(f2g)) + call MAPL_VarWrite(OutFmt,vname,tmp(f2r_land)) call var_iter%next() enddo @@ -1964,7 +1920,6 @@ subroutine createLocalVegRestart(mapping_file, orig_veg, new_veg) call OutFmt%close(rc=rc) deallocate(tmp) endif - deallocate(f2g) end subroutine createLocalVegRestart @@ -2143,7 +2098,7 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di ! assume all land tiles are at the beginning ! UNSAFE ASSUMPTION! - reichle, 2 Aug 2020 - if (typ/=MAPL_Land .and. typ/=MAPL_Land_ExcludeFromDomain) then ! exit if not land + if (typ/=MAPL_Land .and. typ/=MAPL_Land + MAPL_ExcludeFromDomain) then ! exit if not land if (logit) then write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' @@ -2376,7 +2331,7 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di ! assume all land tiles are at the beginning ! UNSAFE ASSUMPTION! - reichle, 2 Aug 2020 - if (typ/=MAPL_Land .and. typ/=MAPL_Land_ExcludeFromDomain) then ! exit if not land + if (typ/=MAPL_Land .and. typ/=MAPL_Land + MAPL_ExcludeFromDomain) then ! exit if not land if (logit) then write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' @@ -3060,10 +3015,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, close(10) ! i here is the number of restart nmuber including types in 'types') - if(present(r2g)) then - allocate(r2g(i)) - r2g = r2g_tmp(1:i) - endif + allocate(r2g, source= r2g_tmp(1:i)) allocate(tile_coord_r(i)) tile_coord_r = tile_coord(1:fid) deallocate(tile_coord) @@ -3071,8 +3023,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing tile_coord_r%pert_i_indg = nint(nodata_generic) tile_coord_r%pert_j_indg = nint(nodata_generic) - N_tile_land = count(tile_coord_r(:)%typ == MAPL_LAND) - call read_catchment_def( catch_file, N_tile_land, tile_coord_r ) + call read_catchment_def( catch_file, N_catg, tile_coord_r ) ! ---------------------------------------------------------------------- ! @@ -3253,7 +3204,7 @@ end subroutine fix_dateline_bug_in_tilecoord ! ********************************************************************** - subroutine read_catchment_def( catchment_def_file, N_tile, tile_coord_r ) + subroutine read_catchment_def( catchment_def_file, N_catg, tile_coord_r ) ! reichle, 17 May 2011: read elevation data if available @@ -3269,16 +3220,16 @@ subroutine read_catchment_def( catchment_def_file, N_tile, tile_coord_r ) character(*), intent(in) :: catchment_def_file - integer, intent(in) :: N_tile_r + integer, intent(in) :: N_catg type(tile_coord_type), dimension(:), pointer :: tile_coord_r ! inout ! locals - integer :: i, istat, sweep, N_land_tile + integer :: i, istat, sweep, N_land_r, N_land_tile integer :: tmp_tileid, tmp_pfaf - real :: min_lon, min_lat, max_lon, max_let, elev + real :: min_lon, min_lat, max_lon, max_lat, elev character(len=*), parameter :: Iam = 'read_catchment_def' character(len=400) :: err_msg @@ -3302,6 +3253,11 @@ subroutine read_catchment_def( catchment_def_file, N_tile, tile_coord_r ) read (10,*) N_land_tile + if ( N_land_tile /= N_catg) then + err_msg = 'tile_coord_file and catchment_def_file mismatch. (1)' + call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) + endif + if (logit) write (logunit,*) 'file contains coordinates for ', N_land_tile, ' tiles' if (logit) write (logunit,*) @@ -3377,8 +3333,9 @@ subroutine read_catchment_def( catchment_def_file, N_tile, tile_coord_r ) end do ! loop through tiles end do ! loop through sweeps - - if ( k-1 /= N_tile_r) then + + N_land_r = count(tile_coord_r(:)%typ == MAPL_LAND) + if ( k-1 /= N_land_r) then err_msg = 'tile_coord_r is not completely read' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if From abfe6f098db690876f1f4d1912cbfff7db392995 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 18 Jul 2024 09:25:23 -0400 Subject: [PATCH 13/55] works for no zoom in --- GEOSldas_App/ldas_setup | 8 +++--- GEOSldas_App/preprocess_ldas_routines.F90 | 31 +++++++++++++---------- 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index bff0f0d7..ae0836ee 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -740,14 +740,12 @@ class LDASsetup: tmp_f2g_file = tempfile.NamedTemporaryFile(delete=False) cmd = self.bindir +'/preprocess_ldas.x c_f2g ' + tile + ' ' + self.domain_def.name + ' '+ self.out_path + ' ' + catchment_def + ' ' + exp_id + ' ' + _y4m2d2h2m2 + ' '+ dzsf + ' ' + tmp_f2g_file.name - print ('Creating f2g file: '+ tmp_f2g_file.name +'....\n') + print ('Creating f2g file if necessary: '+ tmp_f2g_file.name +'....\n') print ("cmd: " + cmd) sp.call(shlex.split(cmd)) # check if it is local or global - with open(tmp_f2g_file.name) as f2gfile : - head=[next(f2gfile) for x in range(2)] - if(head[0].strip() != head[1].strip()) : - self.islocal= True + if os.path.getsize(tmp_f2g_file.name) !=0 : + self.islocal= True #os.remove(self.domain_def.name) # update tile domain diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index ada76036..b5700756 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -158,7 +158,7 @@ subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ym if( .not. c_exist) then print*,"no catchment definition file:" , catch_def_file endif - + if (present(types)) then tile_types = types else @@ -209,14 +209,20 @@ subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ym N_tiles_f(n) = count(tile_coord_f%typ == tile_types(n)) enddo - open(40,file=mapping_file,form='formatted',action='write') - write(40,*)N_types - write(40,*)tile_types - write(40,*)N_tiles_r ! length N_types - write(40,*)N_tiles_f ! length N_types - write(40,*)f2r - write(40,*)r2g - close(40) + if (any(N_tiles_r /= N_tiles_f)) then + print*,"writing mapping file, N_types....", N_types + open(40,file=mapping_file,form='formatted',action='write') + write(40,*)N_types + write(40,*)tile_types + write(40,*)N_tiles_r ! length N_types + write(40,*)N_tiles_f ! length N_types + write(40,*)f2r + write(40,*)r2g + close(40) + else + print*,"No mapping file is created" + endif + if (associated(f2r)) deallocate(f2r) if (associated(r2g)) deallocate(r2g) @@ -2045,7 +2051,7 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di inquire(file=trim(fname_tilefile),exist=file_exist) if( .not. file_exist) then - err_msg = 'tile file does not exist' + err_msg = 'tile file does not exist: ' //trim(fname_tilefile) call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if @@ -2842,7 +2848,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, integer :: i_indg_offset, j_indg_offset, col_order integer :: N_tile_land, n_lon, n_lat logical :: ease_grid - integer :: typ,k,fid + integer :: typ,k integer, dimension(:), allocatable :: tile_types character(256) :: tmpline @@ -3016,8 +3022,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, close(10) ! i here is the number of restart nmuber including types in 'types') allocate(r2g, source= r2g_tmp(1:i)) - allocate(tile_coord_r(i)) - tile_coord_r = tile_coord(1:fid) + allocate(tile_coord_r, source = tile_coord(1:i)) deallocate(tile_coord) deallocate(r2g_tmp) ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing From 0242100a96f29ec80541ff44d5de9d325bd2ab82 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 18 Jul 2024 14:28:34 -0400 Subject: [PATCH 14/55] good for zoomin without other tile types --- GEOSldas_App/ldas_setup | 14 +++++++------- GEOSldas_App/preprocess_ldas_routines.F90 | 2 ++ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index ae0836ee..7ff6646e 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -110,7 +110,7 @@ class LDASsetup: self.out_path = None self.inpdir = None self.exefyl = None - self.islocal = False + self.isZoomIn = False self.catch = '' self.has_mwrtm = False self.has_vegopacity = False @@ -745,11 +745,11 @@ class LDASsetup: sp.call(shlex.split(cmd)) # check if it is local or global if os.path.getsize(tmp_f2g_file.name) !=0 : - self.islocal= True + self.isZoomIn= True #os.remove(self.domain_def.name) # update tile domain - if self.islocal: + if self.isZoomIn: newlocalTile = tile+'.domain' print ("\nCreating local tile file :"+ newlocalTile) print ("\n by excluding land type MAPL_Land_ExcludeFromDomain=1100...\n") @@ -778,7 +778,7 @@ class LDASsetup: bcstmp=bcstmp+[self.bcsdir+'/'+os.path.basename(bcf)] bcs=bcstmp - if self.islocal: + if self.isZoomIn: print ("Creating the boundary files for the simulation domain...\n") bcs_tmp=[] for bcf in bcs : @@ -936,7 +936,7 @@ class LDASsetup: # catchment restart file if os.path.isfile(catchRstFile) : catchLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 - if self.islocal : + if self.isZoomIn : print( "Creating local catchment restart file... \n") cmd=self.bindir +'/preprocess_ldas.x c_localcatchrst '+ catchRstFile +' ' + catchLocal + ' '+ tmp_f2g_file.name print ("cmd: "+cmd) @@ -954,7 +954,7 @@ class LDASsetup: # vegdyn restart file if os.path.isfile(vegdynRstFile) : vegdynLocal = self.rstdir+ensdir +'/'+self.rqdExeInp['EXP_ID']+'.vegdyn_internal_rst' - if self.islocal : + if self.isZoomIn : print ("Creating the local veg restart file... \n") cmd=self.bindir + '/preprocess_ldas.x c_localvegrst '+ vegdynRstFile +' ' + vegdynLocal + ' '+ tmp_f2g_file.name print ("cmd: " + cmd) @@ -989,7 +989,7 @@ class LDASsetup: if self.has_mwrtm : mwRTMRstFile = self.mwrtm_file mwRTMLocal = self.bcsdir+'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.ldas_mwRTMparam.'+y4m2d2_h2m2+'z.nc4' - if self.islocal : + if self.isZoomIn : print ("Creating the local mwRTM restart file... \n") cmd= self.bindir +'/preprocess_ldas.x c_localmwrtmrst '+ mwRTMRstFile +' ' + mwRTMLocal + ' '+ tmp_f2g_file.name diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index b5700756..0e23705d 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -1598,6 +1598,7 @@ subroutine createLocalTilefile(mapping_file, orig_tile, new_tile) if(IS_IOSTAT_END(stat)) exit ! extract first "integer" in "line" and put into "ty" read(line,*) ty + if( any( tile_types == ty)) then ! here g_id is (consecutive) id of the global *land* tiles if (f2g(f_id) /= g_id) then @@ -1609,6 +1610,7 @@ subroutine createLocalTilefile(mapping_file, orig_tile, new_tile) line(n:n+3) = typ_str_exclude else f_id = f_id + 1 + if (f_id >= size(f2g)) f_id = 1 ! just set a number to prevent over flow, it would never come back here endif endif ! write "line" into the output tile file From 72c8daf3591ab553352a3e5bab1cfc60865ed9e1 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 14 Aug 2024 09:41:57 -0400 Subject: [PATCH 15/55] create zoomin landice restart and more cleanup --- GEOSldas_App/ldas_setup | 32 ++++- GEOSldas_App/preprocess_ldas.F90 | 41 +++--- GEOSldas_App/preprocess_ldas_routines.F90 | 155 +++++++++++++++++++--- 3 files changed, 187 insertions(+), 41 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 7ff6646e..d5e7c351 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -752,8 +752,8 @@ class LDASsetup: if self.isZoomIn: newlocalTile = tile+'.domain' print ("\nCreating local tile file :"+ newlocalTile) - print ("\n by excluding land type MAPL_Land_ExcludeFromDomain=1100...\n") - cmd = self.bindir +'/preprocess_ldas.x c_localtile ' + tile + ' ' + newlocalTile + ' '+ tmp_f2g_file.name + print ("\nExcluding tiles not in the domain by adding 1000 to the type ...\n") + cmd = self.bindir +'/preprocess_ldas.x zoomin_tile ' + tile + ' ' + newlocalTile + ' '+ tmp_f2g_file.name print ("cmd: " + cmd) sp.call(shlex.split(cmd)) short_tile=short_tile +'.domain' @@ -782,7 +782,7 @@ class LDASsetup: print ("Creating the boundary files for the simulation domain...\n") bcs_tmp=[] for bcf in bcs : - cmd = self.bindir +'/preprocess_ldas.x c_localbc ' + bcf + ' '+ bcf+'.domain' + ' '+ tmp_f2g_file.name + cmd = self.bindir +'/preprocess_ldas.x zoomin_bc ' + bcf + ' '+ bcf+'.domain' + ' '+ tmp_f2g_file.name print ("cmd: " + cmd) sp.call(shlex.split(cmd)) bcs_tmp=bcs_tmp+[bcf+'.domain'] @@ -910,6 +910,7 @@ class LDASsetup: ensdir = self.ensdirs[iens] ensid = self.ensids[iens] myCatchRst = myRstDir+'/'+self.catch +ensid +'_internal_rst' + myLandiceRst = myRstDir+'/'+ 'landice' +ensid +'_internal_rst' myVegRst = myRstDir+'/'+'vegdyn'+ensid +'_internal_rst' myPertRst = myRstDir+'/'+ 'landpert' +ensid +'_internal_rst' @@ -938,7 +939,7 @@ class LDASsetup: catchLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 if self.isZoomIn : print( "Creating local catchment restart file... \n") - cmd=self.bindir +'/preprocess_ldas.x c_localcatchrst '+ catchRstFile +' ' + catchLocal + ' '+ tmp_f2g_file.name + cmd=self.bindir +'/preprocess_ldas.x zoomin_catchrst '+ catchRstFile +' ' + catchLocal + ' '+ tmp_f2g_file.name print ("cmd: "+cmd) sp.call(shlex.split(cmd)) else : @@ -956,7 +957,7 @@ class LDASsetup: vegdynLocal = self.rstdir+ensdir +'/'+self.rqdExeInp['EXP_ID']+'.vegdyn_internal_rst' if self.isZoomIn : print ("Creating the local veg restart file... \n") - cmd=self.bindir + '/preprocess_ldas.x c_localvegrst '+ vegdynRstFile +' ' + vegdynLocal + ' '+ tmp_f2g_file.name + cmd=self.bindir + '/preprocess_ldas.x zoomin_vegrst '+ vegdynRstFile +' ' + vegdynLocal + ' '+ tmp_f2g_file.name print ("cmd: " + cmd) sp.call(shlex.split(cmd)) else : @@ -969,6 +970,24 @@ class LDASsetup: else : vegdynRstFile = vegdynRstFile0 + landiceRstFile = rstpath+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+'landice_internal_rst.'+y4m2d2_h2m2 + if os.path.isfile(landiceRstFile) : + landiceLocal = self.rstdir+ensdir +'/'+self.rqdExeInp['EXP_ID']+'.landice_internal_rst' + if self.isZoomIn : + print ("Creating coom in landice restart file... \n") + cmd=self.bindir + '/preprocess_ldas.x zoomin_landicerst '+ landiceRstFile +' ' + landiceLocal + ' '+ tmp_f2g_file.name + print ("cmd: " + cmd) + sp.call(shlex.split(cmd)) + else : + shutil.copy(landiceRstFile,landiceLocal) + + landiceRstFile = landiceLocal + + if '0000' in ensdir : + landiceRstFile0 = landiceRstFile + else : + landiceRstFile = landiceRstFile0 + if (self.has_geos_pert and self.perturb == 1) : pertRstFile = rstpath+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.landpert_internal_rst.'+y4m2d2_h2m2 pertLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.landpert_internal_rst.'+y4m2d2_h2m2 @@ -979,6 +998,7 @@ class LDASsetup: print ('vegdynRstFile: ' + vegdynRstFile) os.symlink(catchRstFile, myCatchRst) os.symlink(vegdynRstFile, myVegRst) + os.symlink(landiceRstFile, myLandiceRst) if ( self.has_geos_pert and self.perturb == 1 ): os.symlink(pertRstFile, myPertRst) @@ -991,7 +1011,7 @@ class LDASsetup: mwRTMLocal = self.bcsdir+'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.ldas_mwRTMparam.'+y4m2d2_h2m2+'z.nc4' if self.isZoomIn : print ("Creating the local mwRTM restart file... \n") - cmd= self.bindir +'/preprocess_ldas.x c_localmwrtmrst '+ mwRTMRstFile +' ' + mwRTMLocal + ' '+ tmp_f2g_file.name + cmd= self.bindir +'/preprocess_ldas.x zoomin_mwrtmrst '+ mwRTMRstFile +' ' + mwRTMLocal + ' '+ tmp_f2g_file.name print ("cmd: " + cmd) sp.call(shlex.split(cmd)) diff --git a/GEOSldas_App/preprocess_ldas.F90 b/GEOSldas_App/preprocess_ldas.F90 index a2dbc6fa..460b795d 100644 --- a/GEOSldas_App/preprocess_ldas.F90 +++ b/GEOSldas_App/preprocess_ldas.F90 @@ -6,11 +6,12 @@ program main use preprocess_ldas_routines, ONLY: & create_mapping, & - createLocalTilefile, & - createLocalBC, & - createLocalVegRestart, & - createLocalmwRTMRestart, & - createLocalCatchRestart, & + createZoominTilefile, & + createZoominBC, & + createZoominVegRestart, & + createZoominmwRTMRestart, & + createZoominCatchRestart, & + createZoominLandiceRestart, & correctEase, & convert_pert_rst, & optimize_latlon @@ -46,6 +47,8 @@ program main character(len=512) :: f2g_file character(len=12 ) :: ymdhm character(len=12 ) :: SURFLAY + character(len=:), allocatable :: new_r, orig_r + call get_command_argument(1,option) call get_command_argument(2,arg1) @@ -73,44 +76,52 @@ program main call create_mapping(orig_tile,domain_def_file,trim(out_path),catch_def_file,trim(exp_id),ymdhm, SURFLAY, f2g_file) - else if (trim(option) == "c_localtile") then + else if (trim(option) == "zoomin_tile") then orig_tile = arg1 new_tile = arg2 f2g_file = arg3 - call createLocalTilefile(f2g_file, orig_tile,new_tile) + call createZoominTilefile(f2g_file, orig_tile,new_tile) - else if (trim(option) == "c_localbc" ) then + else if (trim(option) == "zoomin_bc" ) then orig_BC = arg1 new_BC = arg2 f2g_file = arg3 - call createLocalBC(f2g_file, orig_BC, new_BC) + call createZoominBC(f2g_file, orig_BC, new_BC) - else if (trim(option) == "c_localvegrst") then + else if (trim(option) == "zoomin_vegrst") then orig_veg = arg1 new_veg = arg2 f2g_file = arg3 - call createLocalVegRestart(f2g_file, orig_veg, new_veg) + call createZoominVegRestart(f2g_file, orig_veg, new_veg) - else if (trim(option) == "c_localmwrtmrst") then + else if (trim(option) == "zoomin_mwrtmrst") then orig_rtm = arg1 new_rtm = arg2 f2g_file = arg3 - call createLocalmwRTMRestart(f2g_file, orig_rtm, new_rtm) + call createZoominmwRTMRestart(f2g_file, orig_rtm, new_rtm) - else if (trim(option) == "c_localcatchrst") then + else if (trim(option) == "zoomin_catchrst") then orig_catch = arg1 new_catch = arg2 f2g_file = arg3 - call createLocalCatchRestart(f2g_file, orig_catch, new_catch) + call createZoominCatchRestart(f2g_file, orig_catch, new_catch) + + else if (trim(option) == "zoomin_landicerst") then + + orig_r = trim(arg1) + new_r = trim(arg2) + f2g_file = trim(arg3) + + call createZoominLandiceRestart(f2g_file, orig_r, new_r) else if (trim(option)=="correctease") then diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 0e23705d..7288f246 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -86,11 +86,12 @@ module preprocess_ldas_routines private public :: create_mapping - public :: createLocalTilefile - public :: createLocalBC - public :: createLocalCatchRestart - public :: createLocalVegRestart - public :: createLocalmwRTMRestart + public :: createZoominTilefile + public :: createZoominBC + public :: createZoominCatchRestart + public :: createZoominLandiceRestart + public :: createZoominVegRestart + public :: createZoominmwRTMRestart public :: correctEase public :: optimize_latlon public :: convert_pert_rst @@ -1535,7 +1536,7 @@ end subroutine read_mapping ! ******************************************************************** - subroutine createLocalTilefile(mapping_file, orig_tile, new_tile) + subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) implicit none character(*), intent(in) :: mapping_file @@ -1554,12 +1555,12 @@ subroutine createLocalTilefile(mapping_file, orig_tile, new_tile) character(len=4) :: typ_str, typ_str_exclude - character(len=*), parameter :: Iam = 'createLocalTilefile' + character(len=*), parameter :: Iam = 'createZoominTilefile' inquire(file=trim(orig_tile),exist=file_exist) if( .not. file_exist) stop ("original tile file does not exist") - ! Set default local tile file name + ! Set default Zoom in tile file name call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) if( all(N_tiles_r == N_tiles_f)) then print*, "Domain is the same, no need to create tile file..." @@ -1602,7 +1603,7 @@ subroutine createLocalTilefile(mapping_file, orig_tile, new_tile) if( any( tile_types == ty)) then ! here g_id is (consecutive) id of the global *land* tiles if (f2g(f_id) /= g_id) then - ! if tile is not in local domain, replace ty in "line" with 1000+ty" + ! if tile is not in Zoom in domain, replace ty in "line" with 1000+ty" write(typ_str, '(I0)') ty typ_str = adjustr(typ_str) n=index(line, typ_str) @@ -1620,11 +1621,11 @@ subroutine createLocalTilefile(mapping_file, orig_tile, new_tile) close(40) close(50) - end subroutine createLocalTilefile + end subroutine createZoominTilefile ! ******************************************************************** - subroutine createLocalBC(mapping_file, orig_BC, new_BC) + subroutine createZoominBC(mapping_file, orig_BC, new_BC) implicit none character(*),intent(in) :: mapping_file @@ -1657,11 +1658,125 @@ subroutine createLocalBC(mapping_file, orig_BC, new_BC) close(10) close(20) deallocate(tmpvec) - end subroutine createLocalBC + end subroutine createZoominBC ! ******************************************************************** - - subroutine createLocalCatchRestart(mapping_file, orig_catch, new_catch) + + subroutine createZoominLandiceRestart(mapping_file, orig_landice, new_landice) + + implicit none + character(*),intent(in):: mapping_file + character(*),intent(in):: orig_landice + character(*),intent(in):: new_landice + integer,parameter :: subtile=4 + integer :: filetype, rc,i, j, ndims + real,allocatable :: tmp1(:) + type(Netcdf4_FileFormatter) :: InFmt,OutFmt + type(FileMetadata) :: OutCfg + type(FileMetadata) :: InCfg + integer :: dim1,dim2 + type(StringVariableMap), pointer :: variables + type(Variable), pointer :: var + type(StringVariableMapIterator) :: var_iter + type(StringVector), pointer :: var_dimensions + character(len=:), pointer :: vname,dname + integer :: n, N_landicer, N_landicef, N_types, r_starts, f_starts + + integer,dimension(:),allocatable :: f2r, r2g, f2r_landice, tile_types, N_tiles_r, N_tiles_f + logical :: have_landice + + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) + + have_landice = .false. + do n = 1, N_types + if (tile_types(n) == MAPL_LANDICE) then + have_landice = .true. + N_landicef = N_tiles_f(n) + N_landicer = N_tiles_r(n) + exit + endif + enddo + if ( .not. have_landice) return + if (N_landicer == N_landicef) return + + r_starts = sum(N_tiles_r(1:n-1)) + f_starts = sum(N_tiles_f(1:n-1)) + + f2r_landice = f2r( f_starts+1: f_starts+N_landicef) + f2r_landice = f2r_landice - r_starts + + allocate(tmp1(N_landicer)) + + ! check file type + + call MAPL_NCIOGetFileType(orig_landice, filetype,rc=rc) + + if (filetype /= 0) then + print*, "Does not support binary landice restart" + else + + ! filetype = 0 : nc4 output file will also be nc4 + + call InFmt%open(trim(orig_landice), pFIO_READ,rc=rc) + InCfg = InFmt%read(rc=rc) + OutCfg = InCfg + + call OutCfg%modify_dimension('tile', size(f2r_landice), rc=rc) + + call OutFmt%create(trim(new_landice),rc=rc) + call OutFmt%write(OutCfg,rc=rc) + + variables => InCfg%get_variables() + var_iter = variables%begin() + do while (var_iter /= variables%end()) + + vname => var_iter%key() + var => var_iter%value() + var_dimensions => var%get_dimensions() + + ndims = var_dimensions%size() + + if (trim(vname) =='time') then + call var_iter%next() + cycle + endif + + if (ndims == 1) then + call MAPL_VarRead (InFmt,vname,tmp1) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_landice)) + else if (ndims == 2) then + + dname => var%get_ith_dimension(2) + dim1=InCfg%get_dimension(dname) + do j=1,dim1 + call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_landice),offset1=j) + enddo + else if (ndims == 3) then + + dname => var%get_ith_dimension(2) + dim1=InCfg%get_dimension(dname) + dname => var%get_ith_dimension(3) + dim2=InCfg%get_dimension(dname) + do i=1,dim2 + do j=1,dim1 + call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j,offset2=i) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_landice) ,offset1=j,offset2=i) + enddo + enddo + end if + call var_iter%next() + + enddo + call inFmt%close(rc=rc) + call OutFmt%close(rc=rc) + end if ! file type nc4 + print*, "done create Zoom in landice restart" + end subroutine createZoominLandIceRestart + +! *************************************** + + subroutine createZoominCatchRestart(mapping_file, orig_catch, new_catch) implicit none character(*),intent(in):: mapping_file @@ -1791,12 +1906,12 @@ subroutine createLocalCatchRestart(mapping_file, orig_catch, new_catch) call inFmt%close(rc=rc) call OutFmt%close(rc=rc) end if ! file type nc4 - print*, "done create local catchment restart" - end subroutine createLocalCatchRestart + print*, "done create Zoom in catchment restart" + end subroutine createZoominCatchRestart ! ******************************************************************** - subroutine createLocalmwRTMRestart(mapping_file, orig_mwrtm, new_mwrtm) + subroutine createZoominmwRTMRestart(mapping_file, orig_mwrtm, new_mwrtm) implicit none character(*),intent(in):: mapping_file @@ -1847,11 +1962,11 @@ subroutine createLocalmwRTMRestart(mapping_file, orig_mwrtm, new_mwrtm) call inFmt%close(rc=rc) call OutFmt%close(rc=rc) - end subroutine createLocalmwRTMRestart + end subroutine createZoominmwRTMRestart ! ******************************************************************** - subroutine createLocalVegRestart(mapping_file, orig_veg, new_veg) + subroutine createZoominVegRestart(mapping_file, orig_veg, new_veg) implicit none character(*),intent(in):: mapping_file @@ -1929,7 +2044,7 @@ subroutine createLocalVegRestart(mapping_file, orig_veg, new_veg) deallocate(tmp) endif - end subroutine createLocalVegRestart + end subroutine createZoominVegRestart ! ******************************************************************** From 13f7bac9dfd626e37b24cf526ce8e1261dc84959 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 16 Aug 2024 17:00:29 -0400 Subject: [PATCH 16/55] working... --- GEOSldas_App/ldas_setup | 22 ++-- GEOSldas_App/preprocess_ldas.F90 | 47 ++++++-- GEOSldas_App/preprocess_ldas_routines.F90 | 128 +++++++++++++++++++++- 3 files changed, 174 insertions(+), 23 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index d5e7c351..4a022788 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -127,6 +127,7 @@ class LDASsetup: self.bcs_land = '' self.bcs_geom = '' self.bcs_landshared = '' + self.tile_types ='' # ------ # Read exe input file which is required to set up the dir @@ -159,6 +160,9 @@ class LDASsetup: print ('\nInputs from execfile:\n') _printdict(self.rqdExeInp) + tile_types = {'LAND':'100', 'LANDICE':'20'} + self.tile_types = [tile_types[x.strip().upper()] for x in self.rqdExeInp.get('TILE_TYPES','LAND').split(',')] + # nens is an integer and =1 for model run self.nens = int(self.rqdExeInp['NUM_LDAS_ENSEMBLE']) # fail if Nens's val is not int assert self.nens>0, 'NUM_LDAS_ENSEMBLE [%d] <= 0' % self.nens @@ -738,11 +742,11 @@ class LDASsetup: tmp_f2g_file = tempfile.NamedTemporaryFile(delete=False) - cmd = self.bindir +'/preprocess_ldas.x c_f2g ' + tile + ' ' + self.domain_def.name + ' '+ self.out_path + ' ' + catchment_def + ' ' + exp_id + ' ' + _y4m2d2h2m2 + ' '+ dzsf + ' ' + tmp_f2g_file.name + cmd = self.bindir +'/preprocess_ldas.x c_f2g ' + tile + ' ' + self.domain_def.name + ' '+ self.out_path + ' ' + catchment_def + ' ' + exp_id + ' ' + _y4m2d2h2m2 + ' '+ dzsf + ' ' + tmp_f2g_file.name + ' ' + '_'.join(self.tile_types) print ('Creating f2g file if necessary: '+ tmp_f2g_file.name +'....\n') print ("cmd: " + cmd) - sp.call(shlex.split(cmd)) + sp.call(shlex.split(cmd)) # check if it is local or global if os.path.getsize(tmp_f2g_file.name) !=0 : self.isZoomIn= True @@ -750,14 +754,14 @@ class LDASsetup: # update tile domain if self.isZoomIn: - newlocalTile = tile+'.domain' - print ("\nCreating local tile file :"+ newlocalTile) + newZoominTile = tile+'.domain' + print ("\nCreating local tile file :"+ newZoominTile) print ("\nExcluding tiles not in the domain by adding 1000 to the type ...\n") - cmd = self.bindir +'/preprocess_ldas.x zoomin_tile ' + tile + ' ' + newlocalTile + ' '+ tmp_f2g_file.name + cmd = self.bindir +'/preprocess_ldas.x zoomin_tile ' + tile + ' ' + newZoominTile + ' '+ tmp_f2g_file.name print ("cmd: " + cmd) sp.call(shlex.split(cmd)) short_tile=short_tile +'.domain' - tile = newlocalTile + tile = newZoominTile myTile=self.inpdir+'/tile.data' os.symlink(tile,myTile) @@ -972,7 +976,7 @@ class LDASsetup: landiceRstFile = rstpath+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+'landice_internal_rst.'+y4m2d2_h2m2 if os.path.isfile(landiceRstFile) : - landiceLocal = self.rstdir+ensdir +'/'+self.rqdExeInp['EXP_ID']+'.landice_internal_rst' + landiceLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.landice_internal_rst.'+y4m2d2_h2m2 if self.isZoomIn : print ("Creating coom in landice restart file... \n") cmd=self.bindir + '/preprocess_ldas.x zoomin_landicerst '+ landiceRstFile +' ' + landiceLocal + ' '+ tmp_f2g_file.name @@ -998,7 +1002,9 @@ class LDASsetup: print ('vegdynRstFile: ' + vegdynRstFile) os.symlink(catchRstFile, myCatchRst) os.symlink(vegdynRstFile, myVegRst) - os.symlink(landiceRstFile, myLandiceRst) + if ('LANDICE' in self.tile_types) : + print("LANDICE in the types") + os.symlink(landiceRstFile, myLandiceRst) if ( self.has_geos_pert and self.perturb == 1 ): os.symlink(pertRstFile, myPertRst) diff --git a/GEOSldas_App/preprocess_ldas.F90 b/GEOSldas_App/preprocess_ldas.F90 index 460b795d..9d23488c 100644 --- a/GEOSldas_App/preprocess_ldas.F90 +++ b/GEOSldas_App/preprocess_ldas.F90 @@ -6,12 +6,13 @@ program main use preprocess_ldas_routines, ONLY: & create_mapping, & - createZoominTilefile, & - createZoominBC, & - createZoominVegRestart, & - createZoominmwRTMRestart, & - createZoominCatchRestart, & - createZoominLandiceRestart, & + createZoominTilefile, & + createZoominBC, & + createZoominVegRestart, & + createZoominmwRTMRestart, & + createZoominCatchRestart, & + createZoominLandiceRestart, & + createZoominRestart, & correctEase, & convert_pert_rst, & optimize_latlon @@ -27,6 +28,7 @@ program main character(len=512) :: arg6 character(len=512) :: arg7 character(len=512) :: arg8 + character(len=512) :: arg9 character(len=512) :: orig_tile character(len=512) :: new_tile @@ -47,8 +49,9 @@ program main character(len=512) :: f2g_file character(len=12 ) :: ymdhm character(len=12 ) :: SURFLAY - character(len=:), allocatable :: new_r, orig_r - + character(len=:), allocatable :: new_r, orig_r, tile_types + integer :: from, to, n, i, Length + integer, allocatable :: types_(:) call get_command_argument(1,option) call get_command_argument(2,arg1) @@ -59,6 +62,7 @@ program main call get_command_argument(7,arg6) call get_command_argument(8,arg7) call get_command_argument(9,arg8) + call get_command_argument(10,arg9) if( trim(option) == "c_f2g") then @@ -73,8 +77,27 @@ program main ymdhm = trim(adjustl(arg6)) SURFLAY = trim(adjustl(arg7)) f2g_file = arg8 - - call create_mapping(orig_tile,domain_def_file,trim(out_path),catch_def_file,trim(exp_id),ymdhm, SURFLAY, f2g_file) + tile_types = trim(arg9) + n = 1 + Length = len(tile_types) + do i = 1, Length + if (tile_types(i:i) == '_') n = n+1 + enddo + allocate(types_(n)) + from = 0 + to = 1 + n = 1 + do while (to <= Length) + if (tile_types(to:to) == "_") then + read (unit=tile_types(from+1:to-1),fmt=*) types_(n) + n = n + 1 + from = to + endif + to = to + 1 + enddo + read (unit=tile_types(from+1:to-1),fmt=*) types_(n) + print*, types_ + call create_mapping(orig_tile,domain_def_file,trim(out_path),catch_def_file,trim(exp_id),ymdhm, SURFLAY, f2g_file, types_) else if (trim(option) == "zoomin_tile") then @@ -113,7 +136,7 @@ program main new_catch = arg2 f2g_file = arg3 - call createZoominCatchRestart(f2g_file, orig_catch, new_catch) + call createZoominRestart(f2g_file, orig_catch, new_catch, 100) else if (trim(option) == "zoomin_landicerst") then @@ -121,7 +144,7 @@ program main new_r = trim(arg2) f2g_file = trim(arg3) - call createZoominLandiceRestart(f2g_file, orig_r, new_r) + call createZoominRestart(f2g_file, orig_r, new_r, 20) else if (trim(option)=="correctease") then diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 7288f246..b8e3d58c 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -89,6 +89,7 @@ module preprocess_ldas_routines public :: createZoominTilefile public :: createZoominBC public :: createZoominCatchRestart + public :: createZoominRestart public :: createZoominLandiceRestart public :: createZoominVegRestart public :: createZoominmwRTMRestart @@ -161,12 +162,25 @@ subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ym endif if (present(types)) then - tile_types = types + ! reorder tile types so it matches the tile file + allocate(tile_types(size(types))) + n = 1 + if (any(types == MAPL_LAND)) then + tile_types(n) = MAPL_LAND + n = n+1 + endif + if (any(types == MAPL_LAKE)) then + tile_types(n) = MAPL_LAKE + n = n+1 + endif + if (any(types == MAPL_LANDICE)) then + tile_types(n) = MAPL_LANDICE + endif else tile_types = [MAPL_LAND] endif - call LDAS_read_til_file(orig_tile,catch_def_file, tile_grid_g, tile_coord_r, r2g, N_catg, types) + call LDAS_read_til_file(orig_tile,catch_def_file, tile_grid_g, tile_coord_r, r2g, N_catg, tile_types) ! include and exclude files are absolute if(d_exist) then @@ -189,7 +203,7 @@ subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ym trim(out_path), 'exp_domain ', trim(exp_id), & minlon, minlat, maxlon, maxlat, & f2r, tile_coord_f, & - tile_grid_f) + tile_grid_f, types=types) N_catf = count(tile_coord_f(:)%typ == MAPL_LAND) @@ -1775,6 +1789,114 @@ subroutine createZoominLandiceRestart(mapping_file, orig_landice, new_landice) end subroutine createZoominLandIceRestart ! *************************************** + subroutine createZoominRestart(mapping_file, orig_rst, new_rst, tile_type) + + implicit none + character(*),intent(in):: mapping_file + character(*),intent(in):: orig_rst + character(*),intent(in):: new_rst + integer, intent(in) :: tile_type + integer :: istat, filetype, rc,i, j, ndims + real,allocatable :: tmp1(:) + type(Netcdf4_FileFormatter) :: InFmt,OutFmt + type(FileMetadata) :: OutCfg + type(FileMetadata) :: InCfg + integer :: dim1,dim2 + type(StringVariableMap), pointer :: variables + type(Variable), pointer :: var + type(StringVariableMapIterator) :: var_iter + type(StringVector), pointer :: var_dimensions + character(len=:), pointer :: vname,dname + integer ::n, N_r, N_f, N_types, r_starts, f_starts + integer,dimension(:),allocatable :: f2r, r2g, f2r_, tile_types, N_tiles_r, N_tiles_f + + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) + + do n = 1, N_types + if (tile_types(n) == tile_type) then + N_f = N_tiles_f(n) + N_r = N_tiles_r(n) + exit + endif + enddo + + if (N_r == N_f) return + + r_starts = sum(N_tiles_r(1:n-1)) + f_starts = sum(N_tiles_f(1:n-1)) + + f2r_ = f2r( f_starts+1: f_starts+N_f) + f2r_ = f2r_ - r_starts + + allocate(tmp1(N_r)) + + ! check file type + + call MAPL_NCIOGetFileType(orig_rst, filetype,rc=rc) + + if (filetype /= 0) then + print*, "Do not support binary restart" + else + + ! filetype = 0 : nc4 output file will also be nc4 + + call InFmt%open(trim(orig_rst), pFIO_READ,rc=rc) + InCfg = InFmt%read(rc=rc) + OutCfg = InCfg + + call OutCfg%modify_dimension('tile', size(f2r_), rc=rc) + + call OutFmt%create(trim(new_rst),rc=rc) + call OutFmt%write(OutCfg,rc=rc) + + variables => InCfg%get_variables() + var_iter = variables%begin() + do while (var_iter /= variables%end()) + + vname => var_iter%key() + var => var_iter%value() + var_dimensions => var%get_dimensions() + + ndims = var_dimensions%size() + + if (trim(vname) =='time') then + call var_iter%next() + cycle + endif + + if (ndims == 1) then + call MAPL_VarRead (InFmt,vname,tmp1) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_)) + else if (ndims == 2) then + + dname => var%get_ith_dimension(2) + dim1=InCfg%get_dimension(dname) + do j=1,dim1 + call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_),offset1=j) + enddo + + else if (ndims == 3) then + + dname => var%get_ith_dimension(2) + dim1=InCfg%get_dimension(dname) + dname => var%get_ith_dimension(3) + dim2=InCfg%get_dimension(dname) + do i=1,dim2 + do j=1,dim1 + call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j,offset2=i) + call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_) ,offset1=j,offset2=i) + enddo + enddo + + end if + call var_iter%next() + enddo + call inFmt%close(rc=rc) + call OutFmt%close(rc=rc) + end if ! file type nc4 + print*, "done create Zoom in restart of type", tile_type + end subroutine createZoominRestart subroutine createZoominCatchRestart(mapping_file, orig_catch, new_catch) From d4936a6efbd34f1c603f5daa66e84ef42c788b15 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 19 Aug 2024 09:40:01 -0400 Subject: [PATCH 17/55] consolidate creating the restarts --- GEOSldas_App/preprocess_ldas.F90 | 5 +- GEOSldas_App/preprocess_ldas_routines.F90 | 305 ---------------------- 2 files changed, 1 insertion(+), 309 deletions(-) diff --git a/GEOSldas_App/preprocess_ldas.F90 b/GEOSldas_App/preprocess_ldas.F90 index 9d23488c..1ee2a732 100644 --- a/GEOSldas_App/preprocess_ldas.F90 +++ b/GEOSldas_App/preprocess_ldas.F90 @@ -9,9 +9,6 @@ program main createZoominTilefile, & createZoominBC, & createZoominVegRestart, & - createZoominmwRTMRestart, & - createZoominCatchRestart, & - createZoominLandiceRestart, & createZoominRestart, & correctEase, & convert_pert_rst, & @@ -128,7 +125,7 @@ program main new_rtm = arg2 f2g_file = arg3 - call createZoominmwRTMRestart(f2g_file, orig_rtm, new_rtm) + call createZoominRestart(f2g_file, orig_rtm, new_rtm, 100) else if (trim(option) == "zoomin_catchrst") then diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index b8e3d58c..6b660653 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -88,11 +88,8 @@ module preprocess_ldas_routines public :: create_mapping public :: createZoominTilefile public :: createZoominBC - public :: createZoominCatchRestart public :: createZoominRestart - public :: createZoominLandiceRestart public :: createZoominVegRestart - public :: createZoominmwRTMRestart public :: correctEase public :: optimize_latlon public :: convert_pert_rst @@ -1674,120 +1671,6 @@ subroutine createZoominBC(mapping_file, orig_BC, new_BC) deallocate(tmpvec) end subroutine createZoominBC - ! ******************************************************************** - - subroutine createZoominLandiceRestart(mapping_file, orig_landice, new_landice) - - implicit none - character(*),intent(in):: mapping_file - character(*),intent(in):: orig_landice - character(*),intent(in):: new_landice - integer,parameter :: subtile=4 - integer :: filetype, rc,i, j, ndims - real,allocatable :: tmp1(:) - type(Netcdf4_FileFormatter) :: InFmt,OutFmt - type(FileMetadata) :: OutCfg - type(FileMetadata) :: InCfg - integer :: dim1,dim2 - type(StringVariableMap), pointer :: variables - type(Variable), pointer :: var - type(StringVariableMapIterator) :: var_iter - type(StringVector), pointer :: var_dimensions - character(len=:), pointer :: vname,dname - integer :: n, N_landicer, N_landicef, N_types, r_starts, f_starts - - integer,dimension(:),allocatable :: f2r, r2g, f2r_landice, tile_types, N_tiles_r, N_tiles_f - logical :: have_landice - - call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) - - have_landice = .false. - do n = 1, N_types - if (tile_types(n) == MAPL_LANDICE) then - have_landice = .true. - N_landicef = N_tiles_f(n) - N_landicer = N_tiles_r(n) - exit - endif - enddo - if ( .not. have_landice) return - if (N_landicer == N_landicef) return - - r_starts = sum(N_tiles_r(1:n-1)) - f_starts = sum(N_tiles_f(1:n-1)) - - f2r_landice = f2r( f_starts+1: f_starts+N_landicef) - f2r_landice = f2r_landice - r_starts - - allocate(tmp1(N_landicer)) - - ! check file type - - call MAPL_NCIOGetFileType(orig_landice, filetype,rc=rc) - - if (filetype /= 0) then - print*, "Does not support binary landice restart" - else - - ! filetype = 0 : nc4 output file will also be nc4 - - call InFmt%open(trim(orig_landice), pFIO_READ,rc=rc) - InCfg = InFmt%read(rc=rc) - OutCfg = InCfg - - call OutCfg%modify_dimension('tile', size(f2r_landice), rc=rc) - - call OutFmt%create(trim(new_landice),rc=rc) - call OutFmt%write(OutCfg,rc=rc) - - variables => InCfg%get_variables() - var_iter = variables%begin() - do while (var_iter /= variables%end()) - - vname => var_iter%key() - var => var_iter%value() - var_dimensions => var%get_dimensions() - - ndims = var_dimensions%size() - - if (trim(vname) =='time') then - call var_iter%next() - cycle - endif - - if (ndims == 1) then - call MAPL_VarRead (InFmt,vname,tmp1) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_landice)) - else if (ndims == 2) then - - dname => var%get_ith_dimension(2) - dim1=InCfg%get_dimension(dname) - do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_landice),offset1=j) - enddo - else if (ndims == 3) then - - dname => var%get_ith_dimension(2) - dim1=InCfg%get_dimension(dname) - dname => var%get_ith_dimension(3) - dim2=InCfg%get_dimension(dname) - do i=1,dim2 - do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j,offset2=i) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_landice) ,offset1=j,offset2=i) - enddo - enddo - end if - call var_iter%next() - - enddo - call inFmt%close(rc=rc) - call OutFmt%close(rc=rc) - end if ! file type nc4 - print*, "done create Zoom in landice restart" - end subroutine createZoominLandIceRestart - ! *************************************** subroutine createZoominRestart(mapping_file, orig_rst, new_rst, tile_type) @@ -1898,194 +1781,6 @@ subroutine createZoominRestart(mapping_file, orig_rst, new_rst, tile_type) print*, "done create Zoom in restart of type", tile_type end subroutine createZoominRestart - subroutine createZoominCatchRestart(mapping_file, orig_catch, new_catch) - - implicit none - character(*),intent(in):: mapping_file - character(*),intent(in):: orig_catch - character(*),intent(in):: new_catch - integer,parameter :: subtile=4 - integer :: istat, filetype, rc,i, j, ndims - real,allocatable :: tmp1(:) - real,allocatable :: tmp2(:,:) - type(Netcdf4_FileFormatter) :: InFmt,OutFmt - type(FileMetadata) :: OutCfg - type(FileMetadata) :: InCfg - integer :: dim1,dim2 - type(StringVariableMap), pointer :: variables - type(Variable), pointer :: var - type(StringVariableMapIterator) :: var_iter - type(StringVector), pointer :: var_dimensions - character(len=:), pointer :: vname,dname - integer ::n, N_catr, N_catf, N_types - integer,dimension(:),allocatable :: f2r, r2g, f2r_land, tile_types, N_tiles_r, N_tiles_f - - call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) - if (tile_types(1) /= MAPL_LAND) return - if (N_tiles_r(1) == N_tiles_f(1) ) return - N_catf = N_tiles_f(1) - N_catr = N_tiles_r(1) - - f2r_land = f2r(1:N_catf) - - allocate(tmp1(N_catr)) - allocate(tmp2(N_catr,subtile)) - - ! check file type - - call MAPL_NCIOGetFileType(orig_catch, filetype,rc=rc) - - if (filetype /= 0) then - - print*, "Catchment restart is binary" - - ! binary - - open(10,file=trim(orig_catch),form='unformatted',action='read',status='old',iostat=istat) - open(20,file=trim(new_catch),form='unformatted',action='write') - - do n=1,30 - read(10) tmp1 - write(20) tmp1(f2r_land) - enddo - - do n=1,2 - read(10) tmp2 - write(20) tmp2(f2r_land,:) - enddo - - do n=1,20 - read(10) tmp1 - write(20) tmp1(f2r_land) - enddo - ! note : the offline restart does not have the last five variables - do n=1,4 - read(10,iostat=istat) tmp2 - if(.not. IS_IOSTAT_END(istat)) write(20) tmp2(f2r_land,:) - enddo - ! 57 WW - read(10,iostat=istat) tmp2 - if(.not. IS_IOSTAT_END(istat)) write(20) tmp2(f2r_land,:) - - close(10) - close(20) - else - - ! filetype = 0 : nc4 output file will also be nc4 - - call InFmt%open(trim(orig_catch), pFIO_READ,rc=rc) - InCfg = InFmt%read(rc=rc) - OutCfg = InCfg - - call OutCfg%modify_dimension('tile', size(f2r_land), rc=rc) - - call OutFmt%create(trim(new_catch),rc=rc) - call OutFmt%write(OutCfg,rc=rc) - - variables => InCfg%get_variables() - var_iter = variables%begin() - do while (var_iter /= variables%end()) - - vname => var_iter%key() - var => var_iter%value() - var_dimensions => var%get_dimensions() - - ndims = var_dimensions%size() - - if (trim(vname) =='time') then - call var_iter%next() - cycle - endif - - if (ndims == 1) then - call MAPL_VarRead (InFmt,vname,tmp1) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_land)) - else if (ndims == 2) then - - dname => var%get_ith_dimension(2) - dim1=InCfg%get_dimension(dname) - do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_land),offset1=j) - enddo - - else if (ndims == 3) then - - dname => var%get_ith_dimension(2) - dim1=InCfg%get_dimension(dname) - dname => var%get_ith_dimension(3) - dim2=InCfg%get_dimension(dname) - do i=1,dim2 - do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,tmp1 ,offset1=j,offset2=i) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_land) ,offset1=j,offset2=i) - enddo - enddo - - end if - call var_iter%next() - enddo - call inFmt%close(rc=rc) - call OutFmt%close(rc=rc) - end if ! file type nc4 - print*, "done create Zoom in catchment restart" - end subroutine createZoominCatchRestart - - ! ******************************************************************** - - subroutine createZoominmwRTMRestart(mapping_file, orig_mwrtm, new_mwrtm) - - implicit none - character(*),intent(in):: mapping_file - character(*),intent(in):: orig_mwrtm - character(*),intent(in):: new_mwrtm - integer,parameter :: subtile=4 - integer :: rc - real,allocatable :: tmp1(:) - type(Netcdf4_FileFormatter) :: InFmt,OutFmt - type(FileMetadata) :: OutCfg - type(FileMetadata) :: InCfg - - type(StringVariableMap), pointer :: variables - type(StringVariableMapIterator) :: var_iter - character(len=:), pointer :: vname - integer :: N_catr, N_catf, N_types - integer,dimension(:),allocatable :: f2r, r2g, f2r_land, tile_types, N_tiles_r, N_tiles_f - - call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) - if (tile_types(1) /= MAPL_LAND) return - if (N_tiles_r(1) == N_tiles_f(1) ) return - N_catf = N_tiles_f(1) - N_catr = N_tiles_r(1) - - f2r_land = f2r(1:N_catf) - - allocate(tmp1(N_catr)) - - ! nc4 in and out file will also be nc4 - call InFmt%open(trim(orig_mwrtm), pFIO_READ,rc=rc) - InCfg = InFmt%read(rc=rc) - OutCfg = InCfg - - call OutCfg%modify_dimension('tile', N_catf, rc=rc) - - call OutFmt%create(trim(new_mwrtm),rc=rc) - call OutFmt%write(OutCfg,rc=rc) - - variables => InCfg%get_variables() - var_iter = variables%begin() - do while (var_iter /= variables%end()) - vname => var_iter%key() - call MAPL_VarRead (InFmt,vname,tmp1) - call MAPL_VarWrite(OutFmt,vname,tmp1(f2r_land)) - call var_iter%next() - enddo - - call inFmt%close(rc=rc) - call OutFmt%close(rc=rc) - - end subroutine createZoominmwRTMRestart - ! ******************************************************************** subroutine createZoominVegRestart(mapping_file, orig_veg, new_veg) From 2c5102ecc9cda2bc773b916af99db2a1724fe1fa Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 19 Aug 2024 13:29:25 -0400 Subject: [PATCH 18/55] bug fix --- GEOSldas_App/ldas_setup | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 71e2d87b..a7b2c488 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -910,6 +910,7 @@ class LDASsetup: #for ens in self.ensdirs : catchRstFile0 = '' vegdynRstFile0 = '' + landiceRstFile0 = '' for iens in range(self.nens) : ensdir = self.ensdirs[iens] ensid = self.ensids[iens] From 10709a444be30cd67cabec3ff18ee3e465e2453e Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 19 Aug 2024 18:15:53 -0400 Subject: [PATCH 19/55] more bug fix --- GEOSldas_App/preprocess_ldas_routines.F90 | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 6b660653..38508f76 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -200,7 +200,7 @@ subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ym trim(out_path), 'exp_domain ', trim(exp_id), & minlon, minlat, maxlon, maxlat, & f2r, tile_coord_f, & - tile_grid_f, types=types) + tile_grid_f) N_catf = count(tile_coord_f(:)%typ == MAPL_LAND) @@ -344,7 +344,7 @@ subroutine domain_setup( & exclude_path, exclude_file, include_path, include_file, & work_path, exp_domain, exp_id, & minlon, minlat, maxlon, maxlat, & - f2r, tile_coord_f, tile_grid_f, types ) + f2r, tile_coord_f, tile_grid_f ) ! Set up modeling domain and determine index vectors mapping from the ! domain to global catchment space. @@ -413,7 +413,6 @@ subroutine domain_setup( & type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! output type(grid_def_type), intent(out) :: tile_grid_f - integer, dimension(:), intent(in), optional :: types ! locals @@ -444,14 +443,8 @@ subroutine domain_setup( & ! ! try reading *domain.txt, *tilecoord.txt, and *tilegrids.txt files - !call io_domain_files( 'r', work_path, exp_id, & - ! N_tile_f, f2g, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) - rc = -1 - if (present(types)) then - tile_types = types - else - tile_types = [MAPL_LAND] - endif + call io_domain_files( 'r', work_path, exp_id, & + N_tile_f, f2r, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) if (rc==0) then ! read was successful @@ -563,8 +556,8 @@ subroutine domain_setup( & tmp_grid_def = tile_grid_g ! cannot use intent(in) tile_grid_g w/ io_domain_files - !call io_domain_files( 'w', work_path, exp_id, & - ! N_tile_f, f2g, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) + call io_domain_files( 'w', work_path, exp_id, & + N_tile_f, f2r, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) end if ! domain/tilecoord/tilegrids files exist @@ -1622,7 +1615,7 @@ subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) line(n:n+3) = typ_str_exclude else f_id = f_id + 1 - if (f_id >= size(f2g)) f_id = 1 ! just set a number to prevent over flow, it would never come back here + if (f_id > size(f2g)) f_id = 1 ! just set a number to prevent over flow, it would never come back here endif endif ! write "line" into the output tile file From 6f343db913a7b8636ec9ac95176c4c033f86841c Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 29 Aug 2024 11:09:00 -0400 Subject: [PATCH 20/55] bug fixed (i_indg) and add LAND_TYPES item --- GEOS_LdasGridComp.F90 | 89 ++++++++++--------- GEOSldas_App/ldas_setup | 10 ++- .../GEOS_MetforceGridComp.F90 | 86 +++++++----------- 3 files changed, 88 insertions(+), 97 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 5ff7947a..f30f7627 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -87,7 +87,7 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: ensid_string,childname - character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR, WITH_LANDICE_STR + character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR, TILE_TYPES_STR integer :: ens_id_width ! Local variables type(T_TILECOORD_STATE), pointer :: tcinternal @@ -158,11 +158,11 @@ subroutine SetServices(gc, rc) VERIFY_(STATUS) land_assim = (trim(LAND_ASSIM_STR) /= 'NO') - call MAPL_GetResource ( MAPL, WITH_LANDICE_STR, Label="WITH_LANDICE:", DEFAULT="NO", RC=STATUS) + call MAPL_GetResource ( MAPL, TILE_TYPES_STR, Label="TILE_TYPES:", DEFAULT="LAND", RC=STATUS) VERIFY_(STATUS) - WITH_LANDICE_STR = ESMF_UtilStringUpperCase(WITH_LANDICE_STR, rc=STATUS) + TILE_TYPES_STR = ESMF_UtilStringUpperCase(TILE_TYPES_STR, rc=STATUS) VERIFY_(STATUS) - with_landice = (trim(WITH_LANDICE_STR) /= 'NO') + with_landice = (index(TILE_TYPES_STR, 'LANDICE') /= 0) call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) @@ -373,9 +373,8 @@ subroutine Initialize(gc, import, export, clock, rc) character(len=ESMF_MAXSTR) :: LAND_PARAMS character(len=ESMF_MAXSTR) :: grid_type - integer :: total_nt, land_nt_local, i, j - real, pointer :: LandTileLats(:) - real, pointer :: LandTileLons(:) + integer :: i, j, k, n + integer :: total_nt, local_nt, tile_id integer, pointer :: local_id(:) real(ESMF_KIND_R8), pointer :: centerX(:,:) real(ESMF_KIND_R8), pointer :: centerY(:,:) @@ -391,7 +390,7 @@ subroutine Initialize(gc, import, export, clock, rc) type(tile_coord_type), dimension(:), pointer :: tile_coord_f => null() integer,dimension(:),pointer :: f2g - integer :: N_catf + integer :: N_f ! number of tiles in full domain integer :: LSM_CHOICE type(grid_def_type) :: tile_grid_g, pert_grid_g @@ -586,46 +585,53 @@ subroutine Initialize(gc, import, export, clock, rc) ! -get-tile-information-from-land's-locstream- call MAPL_LocStreamGet( & land_locstream, & - NT_LOCAL=land_nt_local, & - TILELATS=LandTileLats, & - TILELONS=LandTileLons, & - LOCAL_ID=local_id , & + NT_LOCAL=local_nt, & + LOCAL_ID=local_id, & rc=status & ) VERIFY_(status) - + if (with_landice) then + call MAPL_LocStreamGet( & + force_locstream, & + NT_LOCAL=local_nt, & + LOCAL_ID=local_id, & + rc=status & + ) + VERIFY_(status) + endif + ! -get-component's-internal-state- call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) VERIFY_(status) tcinternal => tcwrap%ptr ! -allocate-memory-for-tile-coord- - allocate(tcinternal%tile_coord(land_nt_local), stat=status) + allocate(tcinternal%tile_coord(local_nt), stat=status) VERIFY_(status) - allocate(tcinternal%l2f(land_nt_local)) + allocate(tcinternal%l2f(local_nt)) VERIFY_(status) - call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="./", RC=STATUS) call init_MPI_types() - call MPI_Reduce(land_nt_local,total_nt,1,MPI_INT,MPI_SUM,0,mpicomm,mpierr); + call MPI_AllReduce(local_nt,total_nt,1,MPI_INT,MPI_SUM,mpicomm,mpierr); decomf = get_io_filename(trim(out_path), trim(exp_id), 'ldas_domdecomp', date_time=start_time, & dir_name='rc_out', file_ext='.txt') + if (IamRoot) then - call io_domain_files('r',trim(out_path), trim(exp_id),N_catf,f2g,tile_coord_f,tile_grid_g,tile_grid_f,RC) + call io_domain_files('r',trim(out_path), trim(exp_id),N_f,f2g,tile_coord_f,tile_grid_g,tile_grid_f,RC) ! WY notes: f2g == tile_coord_f%tile_id deallocate(f2g) - print*, "Number of tiles: ", N_catf - if(N_catf /= total_nt) then + print*, "Number of tiles: ", N_f + if(N_f /= total_nt) then print*, "total_nt = ", total_nt stop "tiles number not equal" endif open(10,file= trim(decomf), action='write') - write(10,*) N_catf + write(10,*) N_f close(10) call io_grid_def_type('w', logunit, tile_grid_f, 'tile_grid_f') @@ -647,12 +653,12 @@ subroutine Initialize(gc, import, export, clock, rc) ! arrive here when tile_grid_g is cube-sphere and pert_grid_g is lat/lon after call to get_pert_grid() above !1) get pert_i_indg, pert_j_indg for tiles in (full) domain relative to pert_grid_g - do i = 1, N_catf + do i = 1, N_f call get_ij_ind_from_latlon(pert_grid_g,tile_coord_f(i)%com_lat,tile_coord_f(i)%com_lon, & tile_coord_f(i)%pert_i_indg,tile_coord_f(i)%pert_j_indg) enddo !2) determine pert_grid_f - pert_grid_f = get_minExtent_grid(N_catf, tile_coord_f%pert_i_indg, tile_coord_f%pert_j_indg, & + pert_grid_f = get_minExtent_grid(N_f, tile_coord_f%pert_i_indg, tile_coord_f%pert_j_indg, & tile_coord_f%min_lon, tile_coord_f%min_lat, tile_coord_f%max_lon, tile_coord_f%max_lat, & pert_grid_g) @@ -666,34 +672,37 @@ subroutine Initialize(gc, import, export, clock, rc) endif endif - call MPI_BCAST(N_catf,1,MPI_INTEGER,0,mpicomm,mpierr) - if (.not. IamRoot) allocate(tile_coord_f(N_catf)) - - call MPI_BCAST(tile_coord_f,N_catf, MPI_tile_coord_type,0,mpicomm, mpierr) + if (.not. IamRoot) allocate(tile_coord_f(total_nt)) + call MPI_Barrier(mpicomm, mpierr) + call MPI_BCAST(tile_coord_f, total_nt, MPI_tile_coord_type,0,mpicomm, mpierr) call MPI_BCAST(pert_grid_g, 1, MPI_grid_def_type, 0,mpicomm, mpierr) call MPI_BCAST(pert_grid_f, 1, MPI_grid_def_type, 0,mpicomm, mpierr) call MPI_BCAST(tile_grid_g, 1, MPI_grid_def_type, 0,mpicomm, mpierr) block - integer, allocatable :: f2tile_id(:), tile_id2f(:) - integer :: max_id - allocate(f2tile_id(N_catf)) - f2tile_id = tile_coord_f%tile_id - - max_id = maxval(f2tile_id) - allocate(tile_id2f(max_id),source = 0) - do i = 1, N_catf - tile_id2f(f2tile_id(i)) = i + i = 1 + j = 0 + do k = 1, local_nt + do n = i, total_nt + tile_id = tile_coord_f(n)%tile_id + if (local_id(k) == tile_id) then + tcinternal%l2f(k) = n + i = n + 1 + j = j + 1 + exit + endif + enddo enddo - tcinternal%l2f = tile_id2f(local_id) + if (j /= local_nt) then + stop "tile distributtion is wrong. cannot find the right tile" + endif tcinternal%tile_coord = tile_coord_f(tcinternal%l2f) - deallocate(f2tile_id, tile_id2f) end block do i = 0, numprocs-1 if( i == myid) then open(10,file= trim(decomf), action='write',position='append') - do j = 1, land_nt_local + do j = 1, local_nt write(10,*) local_id(j), myid enddo close(10) @@ -703,7 +712,7 @@ subroutine Initialize(gc, import, export, clock, rc) allocate(tcinternal%tile_coord_f,source = tile_coord_f) - pert_grid_l = get_minExtent_grid(land_nt_local, & + pert_grid_l = get_minExtent_grid(local_nt, & tcinternal%tile_coord%pert_i_indg, tcinternal%tile_coord%pert_j_indg, & tcinternal%tile_coord%min_lon, tcinternal%tile_coord%min_lat, & tcinternal%tile_coord%max_lon, tcinternal%tile_coord%max_lat, & diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index a7b2c488..50dc3ab4 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -1003,7 +1003,7 @@ class LDASsetup: print ('vegdynRstFile: ' + vegdynRstFile) os.symlink(catchRstFile, myCatchRst) os.symlink(vegdynRstFile, myVegRst) - if ('LANDICE' in self.tile_types) : + if ('20' in self.tile_types) : print("LANDICE in the types") os.symlink(landiceRstFile, myLandiceRst) if ( self.has_geos_pert and self.perturb == 1 ): @@ -1214,6 +1214,9 @@ class LDASsetup: rstkey=[catch_,'VEGDYN'] rstval=[self.catch,'vegdyn'] + if '20' in self.tile_types: + rstkey.append('LANDICE') + rstval.append('landice') if self.has_mwrtm : keyn='LANDASSIM_INTERNAL_RESTART_FILE' @@ -1248,7 +1251,10 @@ class LDASsetup: keyn = catch_ + '_INTERNAL_CHECKPOINT_FILE' valn = self.catch+tmpl_+'_internal_checkpoint' ldasrcInp[keyn]= valn - + keyn = 'LANDICE_INTERNAL_CHECKPOINT_FILE' + valn = 'landice'+tmpl_+'_internal_checkpoint' + if '20' in self.tile_types : + ldasrcInp[keyn]= valn # specify LANDPERT restart file if (self.perturb == 1): keyn = 'LANDPERT_INTERNAL_RESTART_FILE' diff --git a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index 06f59c92..6e4e9cea 100644 --- a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -59,7 +59,6 @@ module GEOS_MetforceGridCompMod ! Met forcing data type(met_force_type), pointer, contiguous :: DataPrv(:) type(met_force_type), pointer, contiguous :: DataNxt(:) - type(tile_coord_type),pointer, contiguous :: tile_coord(:) end type T_MET_FORCING ! Internal state and its wrapper @@ -604,18 +603,15 @@ subroutine Initialize(gc, import, export, clock, rc) type(METFORCE_WRAP) :: wrap type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), pointer :: tile_coord(:)=>null() - type(tile_coord_type), pointer :: tile_coord_tmp(:)=>null() ! Misc variables - integer :: nt_local, k, NUM_ENSEMBLE, i1, i2, j1, j2 + integer :: locat_nt, k, NUM_ENSEMBLE, i1, i2, j1, j2 integer :: ForceDtStep type(met_force_type) :: mf_nodata logical :: MERRA_file_specs, ensemble_forcing logical :: backward_looking_fluxes real, pointer :: TileLats(:) real, pointer :: TileLons(:) - integer, pointer :: i_indg(:) - integer, pointer :: j_indg(:) integer, pointer :: tiletype(:) integer :: AEROSOL_DEPOSITION type(MAPL_LocStream) :: locstream @@ -651,17 +647,15 @@ subroutine Initialize(gc, import, export, clock, rc) ! Get component's internal tile_coord variable call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) VERIFY_(status) - tile_coord_tmp => tcwrap%ptr%tile_coord + tile_coord => tcwrap%ptr%tile_coord call MAPL_Get(MAPL, LocStream=locstream) VERIFY_(status) call MAPL_LocStreamGet( & locstream, & - NT_LOCAL=nt_local, & - TILELATS=TileLats, & - TILELONS=TileLons, & - LOCAL_I =i_indg, & - LOCAL_J =j_indg, & + NT_LOCAL=locat_nt, & + TILELATS=TileLats, & + TILELONS=TileLons, & TILETYPE=tiletype, & rc=status & ) @@ -679,28 +673,6 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_GridGet(agrid, globalCellCountPerDim=dims, rc=status) VERIFY_(STATUS) im_world_cs = dims(1) - !change local index to global. Only cubed-sphere grid cares about the index in geting forcing - call ESMF_GRID_INTERIOR(agrid,I1,I2,J1,J2) - i_indg = i_indg + i1 -1 - j_indg = j_indg + j1 -1 - if (any(tile_coord_tmp%i_indg /= i_indg(1:NUM_LAND_TILE))) then - _FAIL('i_indg index does not match') - endif - if (any(tile_coord_tmp%j_indg /= j_indg(1:NUM_LAND_TILE))) then - _FAIL('j_indg index does not match') - endif - endif - - allocate(mf%tile_coord(nt_local)) - mf%tile_coord(1:NUM_LAND_TILE) = tile_coord_tmp - - if (NUM_LANDICE_TILE > 0 ) then - i1 = NUM_LAND_TILE + 1 - i2 = NUM_LAND_TILE + NUM_LANDICE_TILE - mf%tile_coord(i1:i2)%com_lon = TileLons(i1:i2)*MAPL_RADIANS_TO_DEGREES - mf%tile_coord(i1:i2)%com_lat = TileLats(i1:i2)*MAPL_RADIANS_TO_DEGREES - mf%tile_coord(i1:i2)%i_indg = i_indg(i1:i2) - mf%tile_coord(i1:i2)%j_indg = j_indg(i1:i2) endif call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & @@ -744,12 +716,12 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) ! -allocate-memory-for-metforcing-data- mf_nodata = nodata_generic - allocate(mf%DataPrv(nt_local), source=mf_nodata, stat=status) + allocate(mf%DataPrv(locat_nt), source=mf_nodata, stat=status) VERIFY_(status) - allocate(mf%DataNxt(nt_local), source=mf_nodata, stat=status) + allocate(mf%DataNxt(locat_nt), source=mf_nodata, stat=status) VERIFY_(status) ! -allocate-memory-for-avg-zenith-angle - allocate(mf%zenav(nt_local), source=nodata_generic, stat=status) + allocate(mf%zenav(locat_nt), source=nodata_generic, stat=status) VERIFY_(status) call MAPL_GetResource ( MAPL, ENS_FORCING_STR, Label="ENSEMBLE_FORCING:", DEFAULT="NO", RC=STATUS) VERIFY_(STATUS) @@ -767,7 +739,6 @@ subroutine Initialize(gc, import, export, clock, rc) endif ! Put MetForcing in Ldas' pvt internal state internal%mf = mf - tile_coord => internal%mf%tile_coord ! Create alarm for MetForcing ! -create-nonsticky-alarm- MetForcingAlarm = ESMF_AlarmCreate( & @@ -792,7 +763,7 @@ subroutine Initialize(gc, import, export, clock, rc) ForceDtStep, & internal%mf%Path, & internal%mf%Tag, & - nt_local, & + locat_nt, & tile_coord, & internal%mf%hinterp, & AEROSOL_DEPOSITION, & @@ -864,11 +835,12 @@ subroutine Run(gc, import, export, clock, rc) ! Private internal state variables type(T_METFORCE_STATE), pointer :: internal=>null() - type(METFORCE_WRAP) :: wrap + type(METFORCE_WRAP) :: wrap + type(TILECOORD_WRAP) :: tcwrap ! LDAS' tile_coord variable type(tile_coord_type), pointer :: tile_coord(:) ! Misc variables - integer :: nt_local ! number of tiles in local PE + integer :: locat_nt ! number of tiles in local PE integer :: comm logical :: IAmRoot integer :: fdtstep @@ -947,9 +919,8 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr - tile_coord => internal%mf%tile_coord - call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & + call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & DEFAULT=1, RC=STATUS) ! Get number of tiles, tile lats/lons from LocStream @@ -957,7 +928,7 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_LocStreamGet( & locstream, & - NT_LOCAL=nt_local, & + NT_LOCAL=locat_nt, & TILELATS=TileLats, & TILELONS=TileLons, & rc=status & @@ -968,11 +939,11 @@ subroutine Run(gc, import, export, clock, rc) call MAPL_Get(MAPL, orbit=orbit) ! Allocate memory for zenith angle - allocate(zth(nt_local), source=nodata_generic, stat=status) + allocate(zth(locat_nt), source=nodata_generic, stat=status) VERIFY_(status) - allocate(slr(nt_local), source=nodata_generic, stat=status) + allocate(slr(locat_nt), source=nodata_generic, stat=status) VERIFY_(status) - allocate(zth_tmp(nt_local), source=nodata_generic, stat=status) + allocate(zth_tmp(locat_nt), source=nodata_generic, stat=status) VERIFY_(status) ! Convert forcing time interval to seconds @@ -982,6 +953,11 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_ClockGetAlarm(clock, 'MetForcing', MetForcingAlarm, rc=status) VERIFY_(status) + ! Get component's internal tile_coord variable + call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) + VERIFY_(status) + tile_coord => tcwrap%ptr%tile_coord + ! Time stamp of next model step ! -get-model-time-step- @@ -1014,7 +990,7 @@ subroutine Run(gc, import, export, clock, rc) fdtstep, & internal%mf%Path, & internal%mf%Tag, & - nt_local, & + locat_nt, & tile_coord, & internal%mf%hinterp, & AEROSOL_DEPOSITION, & @@ -1032,10 +1008,10 @@ subroutine Run(gc, import, export, clock, rc) ! -compute-average-zenith-angle-over-daylight-part-of-forcing-interval- call MAPL_SunGetInsolation( & - TileLons, & - TileLats, & + TileLons, & + TileLats, & orbit, & - zth_tmp, & + zth_tmp, & slr, & currTime=internal%mf%TimePrv, & INTV=internal%mf%ntrvl, & @@ -1049,7 +1025,7 @@ subroutine Run(gc, import, export, clock, rc) ! dayOfYear=DAY_OF_YEAR, RC=STATUS) ! VERIFY_(STATUS) - ! call zenith(DAY_OF_YEAR,SEC_OF_DAY,fdtstep,ModelTimeStep,nt_local,tile_coord%com_lon, & + ! call zenith(DAY_OF_YEAR,SEC_OF_DAY,fdtstep,ModelTimeStep,locat_nt,tile_coord%com_lon, & ! tile_coord%com_lat,internal%mf%zenav) @@ -1065,8 +1041,8 @@ subroutine Run(gc, import, export, clock, rc) ! Compute zenith angle at the next time step call MAPL_SunGetInsolation( & - TileLons, & - TileLats, & + TileLons, & + TileLats, & orbit, & zth_tmp, & slr, & @@ -1081,7 +1057,7 @@ subroutine Run(gc, import, export, clock, rc) !call ESMF_TimeGet(ModelTimeNxt, YY=YEAR, S=SEC_OF_DAY, & ! dayOfYear=DAY_OF_YEAR, RC=STATUS) !VERIFY_(STATUS) - !do n=1, nt_local + !do n=1, locat_nt ! call solar(tile_coord(n)%com_lon,tile_coord(n)%com_lat, DAY_OF_YEAR,SEC_OF_DAY,zth(n),slr(n)) !enddo @@ -1104,7 +1080,7 @@ subroutine Run(gc, import, export, clock, rc) ! Allocate memory for interpolated MetForcing data mf_nodata = nodata_generic - allocate(mfDataNtp(nt_local), source=mf_nodata, stat=status) + allocate(mfDataNtp(locat_nt), source=mf_nodata, stat=status) VERIFY_(status) ! Interpolate MetForcing data to the end of model integration time step From a5b2d2a32935ce02163581c58d789a694cfc9ee5 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 16 Oct 2024 09:24:16 -0400 Subject: [PATCH 21/55] landice model simulation only --- GEOS_LdasGridComp.F90 | 432 +++++++++++----------- GEOSldas_App/ldas_setup | 278 +++++++------- GEOSldas_App/preprocess_ldas.F90 | 60 +-- GEOSldas_App/preprocess_ldas_routines.F90 | 174 ++++----- LDAS_Shared/LDAS_Convert.F90 | 24 ++ 5 files changed, 519 insertions(+), 449 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index f30f7627..42d7bfa4 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -20,7 +20,7 @@ module GEOS_LdasGridCompMod use LDAS_TileCoordType, only: tile_coord_type , T_TILECOORD_STATE, TILECOORD_WRAP use LDAS_TileCoordType, only: grid_def_type, io_grid_def_type, operator (==) use LDAS_TileCoordRoutines, only: get_minExtent_grid, get_ij_ind_from_latlon, io_domain_files - use LDAS_ConvertMod, only: esmf2ldas + use LDAS_ConvertMod, only: esmf2ldas, string2tile_types use LDAS_PertRoutinesMod, only: get_pert_grid use LDAS_ensdrv_functions,ONLY: get_io_filename use LDAS_DateTimeMod,ONLY: date_time_type @@ -62,6 +62,7 @@ module GEOS_LdasGridCompMod logical :: mwRTM logical :: ensemble_forcing ! switch between deterministic and ensemble forcing logical :: with_landice + logical :: with_land contains !BOP @@ -89,6 +90,7 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: ensid_string,childname character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR, TILE_TYPES_STR integer :: ens_id_width + character(10), allocatable :: tile_types(:) ! Local variables type(T_TILECOORD_STATE), pointer :: tcinternal type(TILECOORD_WRAP) :: tcwrap @@ -152,21 +154,37 @@ subroutine SetServices(gc, rc) VERIFY_(STATUS) ensemble_forcing = (trim(ENS_FORCING_STR) == 'YES') + call MAPL_GetResource ( MAPL, TILE_TYPES_STR, Label="TILE_TYPES:", DEFAULT="LAND", RC=STATUS) + VERIFY_(STATUS) + TILE_TYPES_STR = ESMF_UtilStringUpperCase(TILE_TYPES_STR, rc=STATUS) + VERIFY_(STATUS) + call string2tile_types(TILE_TYPES_STR, tile_types) + with_landice = .false. + with_land = .false. +! with_lake = .false. + do i = 1, size(tile_types) + if (trim(tile_types(i)) == 'LANDICE') with_landice = .true. + if (trim(tile_types(i)) == 'LAND') with_land = .true. +! if (trim(tile_types(i)) == 'LAKE') with_lake = .true. + enddo + call MAPL_GetResource ( MAPL, LAND_ASSIM_STR, Label="LAND_ASSIM:", DEFAULT="NO", RC=STATUS) VERIFY_(STATUS) LAND_ASSIM_STR = ESMF_UtilStringUpperCase(LAND_ASSIM_STR, rc=STATUS) VERIFY_(STATUS) land_assim = (trim(LAND_ASSIM_STR) /= 'NO') - call MAPL_GetResource ( MAPL, TILE_TYPES_STR, Label="TILE_TYPES:", DEFAULT="LAND", RC=STATUS) - VERIFY_(STATUS) - TILE_TYPES_STR = ESMF_UtilStringUpperCase(TILE_TYPES_STR, rc=STATUS) - VERIFY_(STATUS) - with_landice = (index(TILE_TYPES_STR, 'LANDICE') /= 0) + if (land_assim .and. .not. with_land) then + _ASSERT( .false., "No land for land assimilation") + endif call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) mwRTM = ( len_trim(mwRTM_file) /= 0 ) + if (mwRTM .and. .not. with_land) then + print*, "No land for assimilation, no mwRTM file is necessary" + mwRTM = .false. + endif call MAPL_GetResource ( MAPL, LSM_CHOICE, Label="LSM_CHOICE:", DEFAULT=1, RC=STATUS) if (LSM_CHOICE /=1 ) then @@ -179,7 +197,7 @@ subroutine SetServices(gc, rc) allocate(METFORCE(1)) endif - allocate(LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) + if (with_land) allocate(LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) if (with_landice) allocate(LANDICE(NUM_ENSEMBLE)) ! ens_id_with = 2 + number of digits = total number of chars in ensid_string ("_eXXXX") @@ -214,13 +232,15 @@ subroutine SetServices(gc, rc) call get_ensid_string(ensid_string, ens_id, ens_id_width, NUM_ENSEMBLE) - childname='LANDPERT'//trim(ensid_string) - LANDPERT(i) = MAPL_AddChild(gc, name=childname, ss=LandPertSetServices, rc=status) - VERIFY_(status) + if (with_land) then + childname='LANDPERT'//trim(ensid_string) + LANDPERT(i) = MAPL_AddChild(gc, name=childname, ss=LandPertSetServices, rc=status) + VERIFY_(status) - childname='LAND'//trim(ensid_string) - LAND(i) = MAPL_AddChild(gc, name=childname, ss=LandSetServices, rc=status) - VERIFY_(status) + childname='LAND'//trim(ensid_string) + LAND(i) = MAPL_AddChild(gc, name=childname, ss=LandSetServices, rc=status) + VERIFY_(status) + endif if (with_landice) then childname='LANDICE'//trim(ensid_string) @@ -229,70 +249,72 @@ subroutine SetServices(gc, rc) endif enddo - ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) - VERIFY_(status) - - if(land_assim .or. mwRTM ) then - LANDASSIM = MAPL_AddChild(gc, name='LANDASSIM', ss=LandAssimSetServices, rc=status) + if (with_land) then + ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) VERIFY_(status) - endif - - ! Connections - do i=1,NUM_ENSEMBLE - k = 1 - if ( ensemble_forcing ) k = i - ! -LANDPERT-feeds-LAND's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['TApert ', 'QApert ', 'UUpert ', & - 'UWINDLMTILEpert', 'VWINDLMTILEpert', 'PCUpert ', & - 'PLSpert ', 'SNOpert ', 'DRPARpert ', & - 'DFPARpert ', 'DRNIRpert ', 'DFNIRpert ', & - 'DRUVRpert ', 'DFUVRpert ', 'LWDNSRFpert '], & - SRC_ID = LANDPERT(i), & - DST_NAME = ['TA ', 'QA ', 'UU ', 'UWINDLMTILE',& - 'VWINDLMTILE', 'PCU ', 'PLS ', 'SNO ',& - 'DRPAR ', 'DFPAR ', 'DRNIR ', 'DFNIR ',& - 'DRUVR ', 'DFUVR ', 'LWDNSRF '], & - DST_ID = LAND(i), & - rc = status & - ) + + if(land_assim .or. mwRTM ) then + LANDASSIM = MAPL_AddChild(gc, name='LANDASSIM', ss=LandAssimSetServices, rc=status) VERIFY_(status) + endif - ! -LAND-feeds-LANDPERT's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['TC ','CATDEF ','RZEXC ','SRFEXC ','WESNN1 ','WESNN2 ','WESNN3 ', & - 'GHTCNT1','GHTCNT2','GHTCNT3','GHTCNT4','GHTCNT5','GHTCNT6', & - 'HTSNNN1','HTSNNN2','HTSNNN3','SNDZN1 ','SNDZN2 ','SNDZN3 '], & - SRC_ID = LAND(i), & - DST_NAME = ['TCPert ','CATDEFPert ','RZEXCPert ','SRFEXCPert ','WESNN1Pert ', & - 'WESNN2Pert ','WESNN3Pert ','GHTCNT1Pert','GHTCNT2Pert', & - 'GHTCNT3Pert','GHTCNT4Pert','GHTCNT5Pert','GHTCNT6Pert', & - 'HTSNNN1Pert','HTSNNN2Pert','HTSNNN3Pert','SNDZN1Pert ', & - 'SNDZN2Pert ','SNDZN3Pert '], & - DST_ID = LANDPERT(i), & - rc = status & - ) - VERIFY_(status) - enddo + ! Connections + do i=1,NUM_ENSEMBLE + k = 1 + if ( ensemble_forcing ) k = i + ! -LANDPERT-feeds-LAND's-imports- + call MAPL_AddConnectivity( & + gc, & + SRC_NAME = ['TApert ', 'QApert ', 'UUpert ', & + 'UWINDLMTILEpert', 'VWINDLMTILEpert', 'PCUpert ', & + 'PLSpert ', 'SNOpert ', 'DRPARpert ', & + 'DFPARpert ', 'DRNIRpert ', 'DFNIRpert ', & + 'DRUVRpert ', 'DFUVRpert ', 'LWDNSRFpert '], & + SRC_ID = LANDPERT(i), & + DST_NAME = ['TA ', 'QA ', 'UU ', 'UWINDLMTILE',& + 'VWINDLMTILE', 'PCU ', 'PLS ', 'SNO ',& + 'DRPAR ', 'DFPAR ', 'DRNIR ', 'DFNIR ',& + 'DRUVR ', 'DFUVR ', 'LWDNSRF '], & + DST_ID = LAND(i), & + rc = status & + ) + VERIFY_(status) - if(land_assim .or. mwRTM) then - ! -LAND-feeds-LANDASSIM's-imports- - ! Catchment model parameters from first LAND ens member, assumes no parameter perturbations! - call MAPL_AddConnectivity( & - gc, & - SHORT_NAME = ['POROS ', 'COND ','PSIS ','BEE ','WPWET ','GNU ','VGWMAX', & - 'BF1 ', 'BF2 ','BF3 ','CDCR1 ','CDCR2 ','ARS1 ', & - 'ARS2 ', 'ARS3 ','ARA1 ','ARA2 ','ARA3 ','ARA4 ', & - 'ARW1 ', 'ARW2 ','ARW3 ','ARW4 ','TSA1 ','TSA2 ','TSB1 ', & - 'TSB2 ', 'ATAU ','BTAU ','ITY ','Z2CH ' ], & - SRC_ID = LAND(1), & ! Note (1) ! - DST_ID = LANDASSIM, & - rc = status & - ) - VERIFY_(status) - endif + ! -LAND-feeds-LANDPERT's-imports- + call MAPL_AddConnectivity( & + gc, & + SRC_NAME = ['TC ','CATDEF ','RZEXC ','SRFEXC ','WESNN1 ','WESNN2 ','WESNN3 ', & + 'GHTCNT1','GHTCNT2','GHTCNT3','GHTCNT4','GHTCNT5','GHTCNT6', & + 'HTSNNN1','HTSNNN2','HTSNNN3','SNDZN1 ','SNDZN2 ','SNDZN3 '], & + SRC_ID = LAND(i), & + DST_NAME = ['TCPert ','CATDEFPert ','RZEXCPert ','SRFEXCPert ','WESNN1Pert ', & + 'WESNN2Pert ','WESNN3Pert ','GHTCNT1Pert','GHTCNT2Pert', & + 'GHTCNT3Pert','GHTCNT4Pert','GHTCNT5Pert','GHTCNT6Pert', & + 'HTSNNN1Pert','HTSNNN2Pert','HTSNNN3Pert','SNDZN1Pert ', & + 'SNDZN2Pert ','SNDZN3Pert '], & + DST_ID = LANDPERT(i), & + rc = status & + ) + VERIFY_(status) + enddo + + if(land_assim .or. mwRTM) then + ! -LAND-feeds-LANDASSIM's-imports- + ! Catchment model parameters from first LAND ens member, assumes no parameter perturbations! + call MAPL_AddConnectivity( & + gc, & + SHORT_NAME = ['POROS ', 'COND ','PSIS ','BEE ','WPWET ','GNU ','VGWMAX', & + 'BF1 ', 'BF2 ','BF3 ','CDCR1 ','CDCR2 ','ARS1 ', & + 'ARS2 ', 'ARS3 ','ARA1 ','ARA2 ','ARA3 ','ARA4 ', & + 'ARW1 ', 'ARW2 ','ARW3 ','ARW4 ','TSA1 ','TSA2 ','TSB1 ', & + 'TSB2 ', 'ATAU ','BTAU ','ITY ','Z2CH ' ], & + SRC_ID = LAND(1), & ! Note (1) ! + DST_ID = LANDASSIM, & + rc = status & + ) + VERIFY_(status) + endif + end if !with_land call MAPL_TimerAdd(gc, name="Initialize", rc=status) VERIFY_(status) @@ -406,6 +428,7 @@ subroutine Initialize(gc, import, export, clock, rc) real :: DT, DT_Solar type(ESMF_Alarm) :: SolarAlarm type(ESMF_TimeInterval) :: Solar_DT + integer, allocatable :: mask(:) ! Begin... @@ -541,8 +564,6 @@ subroutine Initialize(gc, import, export, clock, rc) ) VERIFY_(status) - call MAPL_TimerOff(MAPL, "-LocStreamCreate") - ! Get children and their im/ex states from MAPL obj call MAPL_Get(MAPL, GCS=gcs, GCNAMES=gcnames, rc=status) VERIFY_(status) @@ -550,26 +571,19 @@ subroutine Initialize(gc, import, export, clock, rc) ! Create LAND's locstreams as subset of Surface locstream ! and add it to the children's MAPL objects - call MAPL_TimerOn(MAPL, "-LocStreamCreate") - call MAPL_LocStreamCreate( & - land_locstream, & - surf_locstream, & - name=gcnames(LAND(1)), & - mask=[MAPL_LAND], & - rc=status & - ) - VERIFY_(status) - - if (with_landice) then - call MAPL_LocStreamCreate( & - force_locstream, & + if (with_land) then + call MAPL_LocStreamCreate( & + land_locstream, & surf_locstream, & - name=gcnames(METFORCE(1)), & - mask=[MAPL_LAND, MAPL_LANDICE], & + name=gcnames(LAND(1)), & + mask=[MAPL_LAND], & rc=status & - ) + ) VERIFY_(status) + mask =[MAPL_LAND] + endif + if (with_landice) then call MAPL_LocStreamCreate( & landice_locstream, & surf_locstream, & @@ -578,27 +592,28 @@ subroutine Initialize(gc, import, export, clock, rc) rc=status & ) VERIFY_(status) + mask = [mask, MAPL_LANDICE] endif + call MAPL_LocStreamCreate( & + force_locstream, & + surf_locstream, & + name=gcnames(METFORCE(1)), & + mask=mask, & + rc=status & + ) + VERIFY_(status) + call MAPL_TimerOff(MAPL, "-LocStreamCreate") ! Convert LAND's LocStream to LDAS' tile_coord and save it in the GridComp ! -get-tile-information-from-land's-locstream- - call MAPL_LocStreamGet( & - land_locstream, & - NT_LOCAL=local_nt, & - LOCAL_ID=local_id, & - rc=status & - ) + call MAPL_LocStreamGet( & + force_locstream, & + NT_LOCAL=local_nt, & + LOCAL_ID=local_id, & + rc=status & + ) VERIFY_(status) - if (with_landice) then - call MAPL_LocStreamGet( & - force_locstream, & - NT_LOCAL=local_nt, & - LOCAL_ID=local_id, & - rc=status & - ) - VERIFY_(status) - endif ! -get-component's-internal-state- call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) @@ -726,13 +741,8 @@ subroutine Initialize(gc, import, export, clock, rc) do i = 1, NUM_ENSEMBLE call MAPL_GetObjectFromGC(gcs(METFORCE(i)), CHILD_MAPL, rc=status) VERIFY_(status) ! CHILD = METFORCE - if ( with_landice) then - call MAPL_Set(CHILD_MAPL, LocStream=force_locstream, rc=status) - VERIFY_(status) - else - call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) - VERIFY_(status) - endif + call MAPL_Set(CHILD_MAPL, LocStream=force_locstream, rc=status) + VERIFY_(status) call ESMF_UserCompSetInternalState(gcs(METFORCE(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) @@ -740,16 +750,31 @@ subroutine Initialize(gc, import, export, clock, rc) if (.not. ensemble_forcing) exit enddo - call MAPL_GetObjectFromGC(gcs(ENSAVG), CHILD_MAPL, rc=status) - VERIFY_(status) ! CHILD = ens_avg - call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) - VERIFY_(status) - - do i = 1,NUM_ENSEMBLE - call MAPL_GetObjectFromGC(gcs(LAND(i)), CHILD_MAPL, rc=status) - VERIFY_(status) + if ( with_land) then + call MAPL_GetObjectFromGC(gcs(ENSAVG), CHILD_MAPL, rc=status) + VERIFY_(status) ! CHILD = ens_avg call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) + endif + + do i = 1,NUM_ENSEMBLE + if (with_land) then + call MAPL_GetObjectFromGC(gcs(LAND(i)), CHILD_MAPL, rc=status) + VERIFY_(status) + call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) + VERIFY_(status) + + call MAPL_GetObjectFromGC(gcs(LANDPERT(i)), CHILD_MAPL, rc=status) + VERIFY_(status) ! CHILD = LANDPERT + call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) + VERIFY_(status) + + ! Add LAND's tile_coord to children's GridComps + call ESMF_UserCompSetInternalState(gcs(LAND(i)), 'TILE_COORD', tcwrap, status) + VERIFY_(status) + call ESMF_UserCompSetInternalState(gcs(LANDPERT(i)), 'TILE_COORD', tcwrap, status) + VERIFY_(status) + endif if (with_landice) then call MAPL_GetObjectFromGC(gcs(LANDICE(i)), CHILD_MAPL, rc=status) @@ -757,21 +782,10 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_Set(CHILD_MAPL, LocStream=landice_locstream, rc=status) VERIFY_(status) endif - - call MAPL_GetObjectFromGC(gcs(LANDPERT(i)), CHILD_MAPL, rc=status) - VERIFY_(status) ! CHILD = LANDPERT - call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) - VERIFY_(status) - - ! Add LAND's tile_coord to children's GridComps - call ESMF_UserCompSetInternalState(gcs(LAND(i)), 'TILE_COORD', tcwrap, status) - VERIFY_(status) - call ESMF_UserCompSetInternalState(gcs(LANDPERT(i)), 'TILE_COORD', tcwrap, status) - VERIFY_(status) enddo - if (land_assim .or. mwRTM) then + if (land_assim .or. mwRTM ) then call MAPL_GetObjectFromGC(gcs(LANDASSIM), CHILD_MAPL, rc=status) VERIFY_(status) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) @@ -808,7 +822,6 @@ subroutine Initialize(gc, import, export, clock, rc) if ( IamRoot) call echo_catch_constants(logunit) if ( IamRoot) call StieglitzSnow_echo_constants(logunit) - ! Turn timer off call MAPL_TimerOff(MAPL, "Initialize") call MAPL_TimerOff(MAPL, "TOTAL") @@ -905,27 +918,28 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_TimePrint(ModelTimeCur, options='string', rc=status) VERIFY_(status) end if - + !phase2 initialization ( executed once) !adjust mean of perturbed forcing or Progn - do i = 1,NUM_ENSEMBLE - igc = LANDPERT(i) - call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) - VERIFY_(status) - call MAPL_TimerOff(MAPL, gcnames(igc)) - enddo - - ! Run children GridComps (in order) - ! Generate raw perturbed force and progn - do i = 1,NUM_ENSEMBLE - igc = LANDPERT(i) - call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) - VERIFY_(status) - call MAPL_TimerOff(MAPL, gcnames(igc)) - enddo + if (with_land) then + do i = 1,NUM_ENSEMBLE + igc = LANDPERT(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) + VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) + enddo + ! Run children GridComps (in order) + ! Generate raw perturbed force and progn + do i = 1,NUM_ENSEMBLE + igc = LANDPERT(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) + VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) + enddo + endif ! with_land do i = 1, NUM_ENSEMBLE igc = METFORCE(i) @@ -944,10 +958,13 @@ subroutine Run(gc, import, export, clock, rc) igc = METFORCE(k) call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LAND(i)), clock=clock, phase=2, userRC=status) - VERIFY_(status) - call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDPERT(i)), clock=clock, phase=3, userRC=status) - VERIFY_(status) + if (with_land) then + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LAND(i)), clock=clock, phase=2, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDPERT(i)), clock=clock, phase=3, userRC=status) + VERIFY_(status) + endif + if (with_landice) then call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDICE(i)), clock=clock, phase=4, userRC=status) VERIFY_(status) @@ -957,29 +974,31 @@ subroutine Run(gc, import, export, clock, rc) do i = 1,NUM_ENSEMBLE - !ApplyForcePert - igc = LANDPERT(i) - call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=3, userRC=status) - VERIFY_(status) - call MAPL_TimerOff(MAPL, gcnames(igc)) - - ! Use landpert's output as the input to calculate the ensemble average forcing - ! W.J note: So far it is only for the Catchment model. - ! To make CatchmentCN work with assim, the export from landgrid and catchmentCN grid need to be modified. - if ( LSM_CHOICE == 1 ) then - call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=1, userRC=status) + if (with_land) then + !ApplyForcePert + igc = LANDPERT(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=3, userRC=status) VERIFY_(status) - endif + call MAPL_TimerOff(MAPL, gcnames(igc)) - ! Run the land model - igc = LAND(i) - call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) - VERIFY_(status) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) - VERIFY_(status) - call MAPL_TimerOff(MAPL, gcnames(igc)) + ! Use landpert's output as the input to calculate the ensemble average forcing + ! W.J note: So far it is only for the Catchment model. + ! To make CatchmentCN work with assim, the export from landgrid and catchmentCN grid need to be modified. + if ( LSM_CHOICE == 1 ) then + call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=1, userRC=status) + VERIFY_(status) + endif + + ! Run the land model + igc = LAND(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) + VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) + endif ! with_land if (with_landice) then igc = LANDICE(i) @@ -989,42 +1008,43 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) - endif - - ! ApplyPrognPert - moved: now before calculating ensemble average that is picked up by land analysis and HISTORY; reichle 28 May 2020 - igc = LANDPERT(i) - call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=4, userRC=status) - VERIFY_(status) - call MAPL_TimerOff(MAPL, gcnames(igc)) + endif ! with_land_ice - ! Use LAND's output as the input to calculate the ensemble average - igc = LAND(i) - if (LSM_CHOICE == 1) then - ! collect cat_param - ens_id = i-1 + FIRST_ENS_ID ! id start form FIRST_ENS_ID - call get_ensid_string(ensid_string, ens_id, ens_id_width, NUM_ENSEMBLE) + if (with_land) then + ! ApplyPrognPert - moved: now before calculating ensemble average that is picked up by land analysis and HISTORY; reichle 28 May 2020 + igc = LANDPERT(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=4, userRC=status) + VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) - member_name = 'CATCH'//trim(ensid_string)//"_Exports" + ! Use LAND's output as the input to calculate the ensemble average + igc = LAND(i) + if (LSM_CHOICE == 1) then + ! collect cat_param + ens_id = i-1 + FIRST_ENS_ID ! id start form FIRST_ENS_ID + call get_ensid_string(ensid_string, ens_id, ens_id_width, NUM_ENSEMBLE) - call ESMF_StateGet(gex(igc), trim(member_name), member_export, _RC) - call ESMF_StateGet(gex(igc), "Z2CH", field, _RC) - call ESMF_StateAddReplace(member_export, [field],_RC) - call ESMF_StateGet(gex(igc), "LAI", field, _RC) - call ESMF_StateAddReplace(member_export, [field],_RC) + member_name = 'CATCH'//trim(ensid_string)//"_Exports" - call ESMF_GridCompRun(gcs(ENSAVG), importState=member_export, exportState=gex(ENSAVG), clock=clock,phase=3, userRC=status) - VERIFY_(status) - call ESMF_GridCompRun(gcs(ENSAVG), importState=member_export, exportState=gex(ENSAVG), clock=clock,phase=2, userRC=status) - VERIFY_(status) + call ESMF_StateGet(gex(igc), trim(member_name), member_export, _RC) + call ESMF_StateGet(gex(igc), "Z2CH", field, _RC) + call ESMF_StateAddReplace(member_export, [field],_RC) + call ESMF_StateGet(gex(igc), "LAI", field, _RC) + call ESMF_StateAddReplace(member_export, [field],_RC) - if( mwRTM ) then - ! Calculate ensemble-average L-band Tb using LAND's output (add up and normalize after last member has been added) - call ESMF_GridCompRun(gcs(LANDASSIM), importState=member_export, exportState=gex(LANDASSIM), clock=clock,phase=3, userRC=status) + call ESMF_GridCompRun(gcs(ENSAVG), importState=member_export, exportState=gex(ENSAVG), clock=clock,phase=3, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(ENSAVG), importState=member_export, exportState=gex(ENSAVG), clock=clock,phase=2, userRC=status) VERIFY_(status) - endif - endif + if( mwRTM ) then + ! Calculate ensemble-average L-band Tb using LAND's output (add up and normalize after last member has been added) + call ESMF_GridCompRun(gcs(LANDASSIM), importState=member_export, exportState=gex(LANDASSIM), clock=clock,phase=3, userRC=status) + VERIFY_(status) + endif + endif + endif ! with_land enddo if ( mwRTM .and. LSM_CHOICE == 1 ) then diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 50dc3ab4..e4cf903b 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -128,6 +128,8 @@ class LDASsetup: self.bcs_geom = '' self.bcs_landshared = '' self.tile_types ='' + self.with_land = False + self.with_landice = False # ------ # Read exe input file which is required to set up the dir @@ -162,6 +164,10 @@ class LDASsetup: tile_types = {'LAND':'100', 'LANDICE':'20'} self.tile_types = [tile_types[x.strip().upper()] for x in self.rqdExeInp.get('TILE_TYPES','LAND').split(',')] + if "100" in self.tile_types : + self.with_land = True + if "20" in self.tile_types : + self.with_landice = True # nens is an integer and =1 for model run self.nens = int(self.rqdExeInp['NUM_LDAS_ENSEMBLE']) # fail if Nens's val is not int @@ -272,46 +278,49 @@ class LDASsetup: self.rqdExeInp['RESTART_PATH'] = self.rqdExeInp['RESTART_PATH']+'/' # make sure catchment and vegdyn restart files ( at least one for each) exist - if 'CATCH_DEF_FILE' not in self.rqdExeInp: - self.rqdExeInp['CATCH_DEF_FILE']= self.bcs_land + 'clsm/catchment.def' - assert os.path.isfile(self.rqdExeInp['CATCH_DEF_FILE']),"[%s] file does not exist " % self.rqdExeInp['CATCH_DEF_FILE'] + if 'CATCH_DEF_FILE' not in self.rqdExeInp : + self.rqdExeInp['CATCH_DEF_FILE']= self.bcs_land + 'clsm/catchment.def' + if (self.with_land) : + assert os.path.isfile(self.rqdExeInp['CATCH_DEF_FILE']),"[%s] file does not exist " % self.rqdExeInp['CATCH_DEF_FILE'] self.rqdExeInp['RST_FROM_GLOBAL'] = 1 - if self.rqdExeInp['RESTART'].isdigit() : - if int(self.rqdExeInp['RESTART']) == 1 : - _numg = int(linecache.getline(self.rqdExeInp['CATCH_DEF_FILE'], 1).strip()) - _numd = _numg - ldas_domain = self.rqdExeInp['RESTART_PATH']+ \ - self.rqdExeInp['RESTART_ID'] + \ - '/output/'+self.rqdExeInp['RESTART_DOMAIN']+'/rc_out/'+self.rqdExeInp['RESTART_ID']+'.ldas_domain.txt' - if os.path.isfile(ldas_domain) : - _numd = int(linecache.getline(ldas_domain, 1).strip()) - - if _numg != _numd : - self.rqdExeInp['RST_FROM_GLOBAL'] = 0 - - self.rqdExeInp['LNFM_FILE'] = '' - if int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1 : - self.rqdExeInp['TILING_FILE'] =glob.glob(self.bcs_geom + '*.til')[0] - self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] - self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] - tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') - if (len(tmp_) ==1) : - self.rqdExeInp['LNFM_FILE'] = tmp_[0] - self.rqdExeInp['NDVI_FILE'] = glob.glob(self.bcs_land + 'ndvi_clim_*.data')[0] - self.rqdExeInp['NIRDF_FILE']= glob.glob(self.bcs_land + 'nirdf_*.dat')[0] - self.rqdExeInp['VISDF_FILE']= glob.glob(self.bcs_land + 'visdf_*.dat')[0] - else : - inpdir=self.rqdExeInp['RESTART_PATH']+self.rqdExeInp['RESTART_ID']+'/input/' - self.rqdExeInp['TILING_FILE'] =os.path.realpath(glob.glob(inpdir+'*tile.data')[0]) - self.rqdExeInp['GRN_FILE']= os.path.realpath(glob.glob(inpdir+'green*data')[0]) - self.rqdExeInp['LAI_FILE']= os.path.realpath(glob.glob(inpdir+'lai*data')[0]) - tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') - if (len(tmp_) == 1) : - self.rqdExeInp['LNFM_FILE'] = tmp_[0] - self.rqdExeInp['NDVI_FILE']= os.path.realpath(glob.glob(inpdir+'ndvi*data')[0]) - self.rqdExeInp['NIRDF_FILE']= os.path.realpath(glob.glob(inpdir+'nirdf*data')[0]) - self.rqdExeInp['VISDF_FILE']= os.path.realpath(glob.glob(inpdir+'visdf*data')[0]) + # skip checking. It is users' reponsibility to make it right! + #if self.rqdExeInp['RESTART'].isdigit() : + # if int(self.rqdExeInp['RESTART']) == 1 : + # _numg = int(linecache.getline(self.rqdExeInp['CATCH_DEF_FILE'], 1).strip()) + # _numd = _numg + # ldas_domain = self.rqdExeInp['RESTART_PATH']+ \ + # self.rqdExeInp['RESTART_ID'] + \ + # '/output/'+self.rqdExeInp['RESTART_DOMAIN']+'/rc_out/'+self.rqdExeInp['RESTART_ID']+'.ldas_domain.txt' + # if os.path.isfile(ldas_domain) : + # _numd = int(linecache.getline(ldas_domain, 1).strip()) + # + # if _numg != _numd : + # self.rqdExeInp['RST_FROM_GLOBAL'] = 0 + + if self.with_land : + self.rqdExeInp['LNFM_FILE'] = '' + if int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1 : + self.rqdExeInp['TILING_FILE'] =glob.glob(self.bcs_geom + '*.til')[0] + self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] + self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] + tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') + if (len(tmp_) ==1) : + self.rqdExeInp['LNFM_FILE'] = tmp_[0] + self.rqdExeInp['NDVI_FILE'] = glob.glob(self.bcs_land + 'ndvi_clim_*.data')[0] + self.rqdExeInp['NIRDF_FILE']= glob.glob(self.bcs_land + 'nirdf_*.dat')[0] + self.rqdExeInp['VISDF_FILE']= glob.glob(self.bcs_land + 'visdf_*.dat')[0] + else : + inpdir=self.rqdExeInp['RESTART_PATH']+self.rqdExeInp['RESTART_ID']+'/input/' + self.rqdExeInp['TILING_FILE'] =os.path.realpath(glob.glob(inpdir+'*tile.data')[0]) + self.rqdExeInp['GRN_FILE']= os.path.realpath(glob.glob(inpdir+'green*data')[0]) + self.rqdExeInp['LAI_FILE']= os.path.realpath(glob.glob(inpdir+'lai*data')[0]) + tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') + if (len(tmp_) == 1) : + self.rqdExeInp['LNFM_FILE'] = tmp_[0] + self.rqdExeInp['NDVI_FILE']= os.path.realpath(glob.glob(inpdir+'ndvi*data')[0]) + self.rqdExeInp['NIRDF_FILE']= os.path.realpath(glob.glob(inpdir+'nirdf*data')[0]) + self.rqdExeInp['VISDF_FILE']= os.path.realpath(glob.glob(inpdir+'visdf*data')[0]) if self.rqdExeInp['RESTART'].isdigit() : if int(self.rqdExeInp['RESTART']) == 2 : @@ -328,7 +337,7 @@ class LDASsetup: in_tilefiles_ = glob.glob(inpdir+'/*.til') self.in_tilefile =os.path.realpath(in_tilefiles_[0]) - if os.path.isfile(ldas_domain) : + if os.path.isfile(ldas_domain) and self.with_land : _numd = int(linecache.getline(ldas_domain, 1).strip()) self.rqdExeInp['TILING_FILE'] =glob.glob(self.bcs_geom + '*.til')[0] self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] @@ -353,7 +362,8 @@ class LDASsetup: if int(self.rqdExeInp['LSM_CHOICE']) == 2 : self.catch = 'catchcnclm40' - assert int(self.rqdExeInp['LSM_CHOICE']) <= 2, "\nLSM_CHOICE=3 (Catchment-CN4.5) is no longer supported. Please set LSM_CHOICE to 1 (Catchment) or 2 (Catchment-CN4.0)" + if self.with_land: + assert int(self.rqdExeInp['LSM_CHOICE']) <= 2, "\nLSM_CHOICE=3 (Catchment-CN4.5) is no longer supported. Please set LSM_CHOICE to 1 (Catchment) or 2 (Catchment-CN4.0)" if 'POSTPROC_HIST' not in self.rqdExeInp: self.rqdExeInp['POSTPROC_HIST'] = 0 @@ -391,7 +401,7 @@ class LDASsetup: self.domain_def.close() # make sure bcs files exist - if self.rqdExeInp['RESTART'].isdigit() : + if self.rqdExeInp['RESTART'].isdigit() and self.with_land : if int(self.rqdExeInp['RESTART']) >= 1 : y4m2='Y%4d/M%02d' % (self.begDates[0].year, self.begDates[0].month) y4m2d2_h2m2='%4d%02d%02d_%02d%02d' % (self.begDates[0].year, self.begDates[0].month, @@ -439,9 +449,9 @@ class LDASsetup: self.in_tilefile = None # DEAL WITH mwRTM input from exec - self.assim = True if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else False + self.assim = True if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' and self.with_land else False # verify mwrtm file - if 'MWRTM_PATH' in self.rqdExeInp : + if 'MWRTM_PATH' in self.rqdExeInp and self.with_land : self.rqdExeInp['MWRTM_PATH'] = self.rqdExeInp['MWRTM_PATH']+'/'+ self.rqdExeInp['BCS_RESOLUTION']+'/' mwrtm_param_file_ = self.rqdExeInp['MWRTM_PATH']+'mwRTM_param.nc4' vegopacity_file_ = self.rqdExeInp['MWRTM_PATH']+'vegopacity.bin' @@ -766,47 +776,47 @@ class LDASsetup: myTile=self.inpdir+'/tile.data' os.symlink(tile,myTile) + if self.with_land: + bcs=[self.rqdExeInp['GRN_FILE'], + self.rqdExeInp['LAI_FILE'], + self.rqdExeInp['NDVI_FILE'], + self.rqdExeInp['NIRDF_FILE'], + self.rqdExeInp['VISDF_FILE'] ] + if (self.rqdExeInp['LNFM_FILE'] != ''): + bcs += [self.rqdExeInp['LNFM_FILE']] + if (self.has_vegopacity): + bcs += [self.rqdExeInp['VEGOPACITY_FILE']] + bcstmp=[] + for bcf in bcs : + shutil.copy(bcf, self.bcsdir+'/') + bcstmp=bcstmp+[self.bcsdir+'/'+os.path.basename(bcf)] + bcs=bcstmp + + if self.isZoomIn: + print ("Creating the boundary files for the simulation domain...\n") + bcs_tmp=[] + for bcf in bcs : + cmd = self.bindir +'/preprocess_ldas.x zoomin_bc ' + bcf + ' '+ bcf+'.domain' + ' '+ tmp_f2g_file.name + print ("cmd: " + cmd) + sp.call(shlex.split(cmd)) + bcs_tmp=bcs_tmp+[bcf+'.domain'] + bcs=bcs_tmp - bcs=[self.rqdExeInp['GRN_FILE'], - self.rqdExeInp['LAI_FILE'], - self.rqdExeInp['NDVI_FILE'], - self.rqdExeInp['NIRDF_FILE'], - self.rqdExeInp['VISDF_FILE'] ] - if (self.rqdExeInp['LNFM_FILE'] != ''): - bcs += [self.rqdExeInp['LNFM_FILE']] - if (self.has_vegopacity): - bcs += [self.rqdExeInp['VEGOPACITY_FILE']] - bcstmp=[] - for bcf in bcs : - shutil.copy(bcf, self.bcsdir+'/') - bcstmp=bcstmp+[self.bcsdir+'/'+os.path.basename(bcf)] - bcs=bcstmp - if self.isZoomIn: - print ("Creating the boundary files for the simulation domain...\n") - bcs_tmp=[] - for bcf in bcs : - cmd = self.bindir +'/preprocess_ldas.x zoomin_bc ' + bcf + ' '+ bcf+'.domain' + ' '+ tmp_f2g_file.name - print ("cmd: " + cmd) - sp.call(shlex.split(cmd)) - bcs_tmp=bcs_tmp+[bcf+'.domain'] - bcs=bcs_tmp - - - # link BC - print ("linking bcs...") - bcnames=['green','lai','ndvi','nirdf','visdf'] - if (self.rqdExeInp['LNFM_FILE'] != ''): - bcnames += ['lnfm'] - if (self.has_vegopacity): - bcnames += ['vegopacity'] - for bcln,bc in zip(bcnames,bcs) : - myBC=self.inpdir+'/'+bcln+'.data' - os.symlink(bc,myBC) - - if ("catchcn" in self.catch): - os.symlink(self.bcs_landshared + 'CO2_MonthlyMean_DiurnalCycle.nc4', \ - self.inpdir+'/CO2_MonthlyMean_DiurnalCycle.nc4') + # link BC + print ("linking bcs...") + bcnames=['green','lai','ndvi','nirdf','visdf'] + if (self.rqdExeInp['LNFM_FILE'] != ''): + bcnames += ['lnfm'] + if (self.has_vegopacity): + bcnames += ['vegopacity'] + for bcln,bc in zip(bcnames,bcs) : + myBC=self.inpdir+'/'+bcln+'.data' + os.symlink(bc,myBC) + + if ("catchcn" in self.catch): + os.symlink(self.bcs_landshared + 'CO2_MonthlyMean_DiurnalCycle.nc4', \ + self.inpdir+'/CO2_MonthlyMean_DiurnalCycle.nc4') # create and link restart print ("Creating and linking restart...") @@ -849,7 +859,7 @@ class LDASsetup: self.has_landassim_seed = True mk_outdir = self.exphome+'/'+exp_id+'/mk_restarts/' - if (RESTART_str != '1'): + if (RESTART_str != '1' and self.with_land): bcs_path = self.rqdExeInp['BCS_PATH'] while bcs_path[-1] == '/' : bcs_path = bcs_path[0:-1] bc_base = os.path.dirname(bcs_path) @@ -940,7 +950,7 @@ class LDASsetup: catchRstFile = glob.glob(self.exphome+'/'+exp_id+'/mk_restarts/*'+self.catch+'_internal_rst.'+YYYYMMDD+'*')[0] # catchment restart file - if os.path.isfile(catchRstFile) : + if os.path.isfile(catchRstFile and self.with_land) : catchLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 if self.isZoomIn : print( "Creating local catchment restart file... \n") @@ -958,7 +968,7 @@ class LDASsetup: catchRstFile = catchRstFile0 # vegdyn restart file - if os.path.isfile(vegdynRstFile) : + if os.path.isfile(vegdynRstFile and self.with_land) : vegdynLocal = self.rstdir+ensdir +'/'+self.rqdExeInp['EXP_ID']+'.vegdyn_internal_rst' if self.isZoomIn : print ("Creating the local veg restart file... \n") @@ -976,7 +986,7 @@ class LDASsetup: vegdynRstFile = vegdynRstFile0 landiceRstFile = rstpath+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+'landice_internal_rst.'+y4m2d2_h2m2 - if os.path.isfile(landiceRstFile) : + if os.path.isfile(landiceRstFile and self.with_landice) : landiceLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.landice_internal_rst.'+y4m2d2_h2m2 if self.isZoomIn : print ("Creating coom in landice restart file... \n") @@ -999,19 +1009,21 @@ class LDASsetup: shutil.copy(pertRstFile,pertLocal) pertRstFile = pertLocal - print ('catchRstFile: ' + catchRstFile) - print ('vegdynRstFile: ' + vegdynRstFile) - os.symlink(catchRstFile, myCatchRst) - os.symlink(vegdynRstFile, myVegRst) - if ('20' in self.tile_types) : - print("LANDICE in the types") + if self.with_land : + print ('catchRstFile: ' + catchRstFile) + print ('vegdynRstFile: ' + vegdynRstFile) + os.symlink(catchRstFile, myCatchRst) + os.symlink(vegdynRstFile, myVegRst) + if self.with_landice : + print("link landice restart: " + myLandiceRst) os.symlink(landiceRstFile, myLandiceRst) if ( self.has_geos_pert and self.perturb == 1 ): os.symlink(pertRstFile, myPertRst) # catch_param restar file catch_param_file = self.bcsdir+'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.ldas_catparam.'+y4m2d2_h2m2+'z.bin' - assert os.path.isfile(catch_param_file), "need catch_param file %s" % catch_param_file + if self.with_land: + assert os.path.isfile(catch_param_file), "need catch_param file %s" % catch_param_file if self.has_mwrtm : mwRTMRstFile = self.mwrtm_file @@ -1089,7 +1101,7 @@ class LDASsetup: # get optimzed NX and IMS optimized_distribution_file = tempfile.NamedTemporaryFile(delete=False) print ("Optimizing... decomposition of processes.... \n") - cmd = self.bindir + '/preprocess_ldas.x optimize '+ self.inpdir+'/tile.data '+ str(self.rqdRmInp['ntasks_model']) + ' ' + optimized_distribution_file.name + ' ' + self.rundir + cmd = self.bindir + '/preprocess_ldas.x optimize '+ self.inpdir+'/tile.data '+ str(self.rqdRmInp['ntasks_model']) + ' ' + optimized_distribution_file.name + ' ' + self.rundir + ' ' + '_'.join(self.tile_types) print ("cmd: " + cmd) print ("IMS.rc or JMS.rc would be generated on " + self.rundir) sp.call(shlex.split(cmd)) @@ -1183,38 +1195,42 @@ class LDASsetup: tmpl_='%s' if self.perturb == 1: ldasrcInp['PERTURBATIONS'] ='1' - bcval=['../input/green','../input/lai','../input/lnfm','../input/ndvi','../input/nirdf','../input/visdf'] - bckey=['GREEN','LAI','LNFM','NDVI','NIRDF','VISDF'] - for key, val in zip(bckey,bcval): - keyn = key+'_FILE' - valn = val+'.data' - ldasrcInp[keyn]= valn - if('catchcn' in self.catch): - ldasrcInp['CO2_MonthlyMean_DiurnalCycle_FILE']= '../input/CO2_MonthlyMean_DiurnalCycle.nc4' - else: - # remove catchcn-specific entries that do not apply to catch model - ldasrcInp.pop('DTCN',None) - ldasrcInp.pop('ATM_CO2',None) - ldasrcInp.pop('CO2',None) - ldasrcInp.pop('CO2_YEAR',None) - ldasrcInp.pop('PRESCRIBE_DVG',None) + rstkey =[] + rstval =[] + if self.with_land : + bcval=['../input/green','../input/lai','../input/lnfm','../input/ndvi','../input/nirdf','../input/visdf'] + bckey=['GREEN','LAI','LNFM','NDVI','NIRDF','VISDF'] + for key, val in zip(bckey,bcval): + keyn = key+'_FILE' + valn = val+'.data' + ldasrcInp[keyn]= valn + if('catchcn' in self.catch): + ldasrcInp['CO2_MonthlyMean_DiurnalCycle_FILE']= '../input/CO2_MonthlyMean_DiurnalCycle.nc4' + else: + # remove catchcn-specific entries that do not apply to catch model + ldasrcInp.pop('DTCN',None) + ldasrcInp.pop('ATM_CO2',None) + ldasrcInp.pop('CO2',None) + ldasrcInp.pop('CO2_YEAR',None) + ldasrcInp.pop('PRESCRIBE_DVG',None) # create restart item in RC - catch_ = self.catch.upper() - - if catch_+'_INTERNAL_RESTART_TYPE' in ldasrcInp : - # avoid duplicate - del ldasrcInp[ catch_ +'_INTERNAL_RESTART_TYPE'] - if catch_+'_INTERNAL_CHECKPOINT_TYPE' in ldasrcInp : - # avoid duplicate - del ldasrcInp[ catch_ +'_INTERNAL_CHECKPOINT_TYPE'] - if 'VEGDYN_INTERNAL_RESTART_TYPE' in ldasrcInp : - # avoid duplicate - del ldasrcInp['VEGDYN_INTERNAL_RESTART_TYPE'] - - rstkey=[catch_,'VEGDYN'] - rstval=[self.catch,'vegdyn'] - if '20' in self.tile_types: + catch_ = self.catch.upper() + + if catch_+'_INTERNAL_RESTART_TYPE' in ldasrcInp : + # avoid duplicate + del ldasrcInp[ catch_ +'_INTERNAL_RESTART_TYPE'] + if catch_+'_INTERNAL_CHECKPOINT_TYPE' in ldasrcInp : + # avoid duplicate + del ldasrcInp[ catch_ +'_INTERNAL_CHECKPOINT_TYPE'] + if 'VEGDYN_INTERNAL_RESTART_TYPE' in ldasrcInp : + # avoid duplicate + del ldasrcInp['VEGDYN_INTERNAL_RESTART_TYPE'] + + rstkey.append(catch_).append('VEGDYN') + rstval.append(self.catch).append('vegdyn') + + if self.with_landice: rstkey.append('LANDICE') rstval.append('landice') @@ -1248,12 +1264,14 @@ class LDASsetup: ldasrcInp[keyn]= valn # checkpoint file and its type - keyn = catch_ + '_INTERNAL_CHECKPOINT_FILE' - valn = self.catch+tmpl_+'_internal_checkpoint' - ldasrcInp[keyn]= valn - keyn = 'LANDICE_INTERNAL_CHECKPOINT_FILE' - valn = 'landice'+tmpl_+'_internal_checkpoint' - if '20' in self.tile_types : + if self.with_land : + keyn = catch_ + '_INTERNAL_CHECKPOINT_FILE' + valn = self.catch+tmpl_+'_internal_checkpoint' + ldasrcInp[keyn]= valn + + if self.with_landice : + keyn = 'LANDICE_INTERNAL_CHECKPOINT_FILE' + valn = 'landice'+tmpl_+'_internal_checkpoint' ldasrcInp[keyn]= valn # specify LANDPERT restart file if (self.perturb == 1): diff --git a/GEOSldas_App/preprocess_ldas.F90 b/GEOSldas_App/preprocess_ldas.F90 index 1ee2a732..20e729a1 100644 --- a/GEOSldas_App/preprocess_ldas.F90 +++ b/GEOSldas_App/preprocess_ldas.F90 @@ -47,8 +47,7 @@ program main character(len=12 ) :: ymdhm character(len=12 ) :: SURFLAY character(len=:), allocatable :: new_r, orig_r, tile_types - integer :: from, to, n, i, Length - integer, allocatable :: types_(:) + integer, allocatable :: int_types(:) call get_command_argument(1,option) call get_command_argument(2,arg1) @@ -74,27 +73,10 @@ program main ymdhm = trim(adjustl(arg6)) SURFLAY = trim(adjustl(arg7)) f2g_file = arg8 - tile_types = trim(arg9) - n = 1 - Length = len(tile_types) - do i = 1, Length - if (tile_types(i:i) == '_') n = n+1 - enddo - allocate(types_(n)) - from = 0 - to = 1 - n = 1 - do while (to <= Length) - if (tile_types(to:to) == "_") then - read (unit=tile_types(from+1:to-1),fmt=*) types_(n) - n = n + 1 - from = to - endif - to = to + 1 - enddo - read (unit=tile_types(from+1:to-1),fmt=*) types_(n) - print*, types_ - call create_mapping(orig_tile,domain_def_file,trim(out_path),catch_def_file,trim(exp_id),ymdhm, SURFLAY, f2g_file, types_) + + call get_tile_types(trim(arg9), int_types) + + call create_mapping(orig_tile,domain_def_file,trim(out_path),catch_def_file,trim(exp_id),ymdhm, SURFLAY, f2g_file, int_types) else if (trim(option) == "zoomin_tile") then @@ -159,15 +141,41 @@ program main else if (trim(option) == "optimize") then - - call optimize_latlon(arg1,arg2, arg3, arg4) + call get_tile_types(trim(arg5), int_types) + call optimize_latlon(arg1,arg2, arg3, arg4, int_types) else print*, " wrong preprocess option:",option end if - + +contains + + subroutine get_tile_types(str_types, int_types) + character(*), intent(in) :: str_types + integer, allocatable, intent(out) :: int_types(:) + integer :: n, Length, from, to, i + n = 1 + Length = len(str_types) + do i = 1, Length + if (str_types(i:i) == '_') n = n+1 + enddo + allocate(int_types(n)) + from = 0 + to = 1 + n = 1 + do while (to <= Length) + if (str_types(to:to) == "_") then + read (unit=str_types(from+1:to-1),fmt=*) int_types(n) + n = n + 1 + from = to + endif + to = to + 1 + enddo + read (unit=tile_types(from+1:to-1),fmt=*) int_types(n) + end subroutine get_tile_types + end program main ! ====================== EOF ======================================================= diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 38508f76..88ba2192 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -1938,7 +1938,7 @@ end subroutine correctEase ! NY: N_proc 1 ! JMS.rc IMS.rc - subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_dir) + subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_dir, types) implicit none @@ -1946,17 +1946,17 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di character(*), intent(in) :: N_proc_string ! *string* w/ no. of processors (or tasks), excl. OSERVER tasks character(*), intent(in) :: optimized_file character(*), intent(in) :: run_dir - + integer, optional, intent(in) :: types(:) ! local variables integer :: N_proc integer :: N_tile,N_lon,N_lat,N_grid - integer,allocatable :: landPosition(:) + integer,allocatable :: tilePosition(:) integer,allocatable :: IMS(:),JMS(:) - integer,allocatable :: local_land(:) - integer :: total_land + integer,allocatable :: local_tile(:) + integer :: total_tile integer :: n,typ,tmpint real :: tmpreal - integer :: avg_land,n0,local + integer :: avg_tile,n0,local integer :: i,s,e,j,k,n1,n2, s1, s2 logical :: file_exist character(len=256):: tmpLine @@ -1966,7 +1966,7 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di integer :: face(6),face_land(6) logical :: forward character(len=:), allocatable :: IMS_file, JMS_File - + integer, allocatable :: tile_types(:) character(len=*), parameter :: Iam = 'optimize_latlon' character(len=400) :: err_msg @@ -1975,6 +1975,11 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di read (N_proc_string,*) N_proc ! input is string for historical reasons... ! get tile info + if (present(types)) then + tile_types = types + else + tile_types = [MAPL_LAND] + endif inquire(file=trim(fname_tilefile),exist=file_exist) if( .not. file_exist) then @@ -1998,9 +2003,9 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if - allocate(landPosition(JMGLOB)) - landPosition = 0 - total_land = 0 + allocate(tilePosition(JMGLOB)) + tilePosition = 0 + total_tile = 0 if(N_grid==2) then read (10,*) ! some string describing ocean grid (?) @@ -2023,27 +2028,24 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di !tmpreal, & ! 11 !tmpint ! 12 * (previously "tile_id") - if(typ==MAPL_Land) then - total_land=total_land+1 - landPosition(j) = landPosition(j)+1 + if(any (tile_types == typ)) then + total_tile=total_tile+1 + tilePosition(j) = tilePosition(j)+1 endif ! assume all land tiles are at the beginning ! UNSAFE ASSUMPTION! - reichle, 2 Aug 2020 - - if (typ/=MAPL_Land .and. typ/=MAPL_Land + MAPL_ExcludeFromDomain) then ! exit if not land - - if (logit) then - write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' - write (logunit,*) ' Stop reading *.til file under the assumption that' - write (logunit,*) ' land tiles are first in *.til file.' - write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' - end if - - exit ! assuming land comes first in the til file - - end if - + if (all (tile_types == MAPL_LAND)) then + if (typ/=MAPL_Land .and. typ/=MAPL_Land + MAPL_ExcludeFromDomain) then ! exit if not land + if (logit) then + write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' + write (logunit,*) ' Stop reading *.til file under the assumption that' + write (logunit,*) ' land tiles are first in *.til file.' + write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' + end if + exit ! assuming land comes first in the til file + end if + endif enddo close(10) @@ -2052,15 +2054,15 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di N_proc = N_proc-mod(N_proc,6) endif - print*, "total tiles: ", total_land + print*, "total tiles: ", total_tile - if(sum(landPosition) /= total_land) print*, "wrong counting of land" + if(sum(tilePosition) /= total_tile) print*, "wrong counting of land" do k=1,6 n1 = (k-1)*IMGLOB+1 n2 = k*IMGLOB - face_land(k) = sum(landPosition(n1:n2)) - face(k) = nint(1.0*face_land(k)/total_land * N_proc) + face_land(k) = sum(tilePosition(n1:n2)) + face(k) = nint(1.0*face_land(k)/total_tile * N_proc) ! ensure each face has at least 1 process if ( face(k) == 0) face(k) = 1 ! ensure that the stripe for each process can be at least 2 cells wide @@ -2096,7 +2098,7 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di n2 = k*IMGLOB s1 = sum(face(1:k-1)) + 1 s2 = sum(face(1:k)) - call equal_partition(landPosition(n1:n2), JMS(s1:s2)) + call equal_partition(tilePosition(n1:n2), JMS(s1:s2)) enddo if( sum(JMS) /= JMGLOB) then @@ -2131,15 +2133,15 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) endif - allocate(local_land(N_Proc), source = 0) + allocate(local_tile(N_Proc), source = 0) s1 = 1 do n = 1, N_proc s2 = s1+JMS(n) - 1 - local_land(n) = sum(landPosition(s1:s2)) + local_tile(n) = sum(tilePosition(s1:s2)) s1 = s2 + 1 enddo - print*,"land_distribute: ",local_land + print*,"tile_distribute: ",local_tile print*, "JMS.rc", JMS if( sum(JMS) /= JMGLOB) then print*, sum(JMS), JMGLOB @@ -2185,9 +2187,9 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di ! *not* cube-sphere tile space allocate(IMS(N_Proc)) - allocate(local_land(N_Proc)) + allocate(local_tile(N_Proc)) IMS=0 - local_land = 0 + local_tile = 0 ! NOTE: ! There is a bug in at least some EASE *.til files through at least Icarus-NLv4. @@ -2224,10 +2226,10 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di s=1 e=N_lon endif - allocate(landPosition(s:e)) + allocate(tilePosition(s:e)) - landPosition=0 - total_land= 0 + tilePosition=0 + total_tile= 0 ! 1) read through tile file, put the land tile into the N_lon of bucket @@ -2237,9 +2239,9 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di tmpreal, & ! 3 tmpreal, & ! 4 i ! 5 - if(typ==MAPL_Land) then - total_land=total_land+1 - landPosition(i) = landPosition(i)+1 + if (any(tile_types == typ)) then + total_tile=total_tile+1 + tilePosition(i) = tilePosition(i)+1 endif do n = 2,N_tile @@ -2256,32 +2258,30 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di !tmpint, & ! 10 !tmpreal, & ! 11 !tmpint ! 12 * (previously "tile_id") - if(typ==MAPL_Land) then - total_land=total_land+1 - landPosition(i) = landPosition(i)+1 + if (any(tile_types == typ)) then + total_tile=total_tile+1 + tilePosition(i) = tilePosition(i)+1 endif ! assume all land tiles are at the beginning ! UNSAFE ASSUMPTION! - reichle, 2 Aug 2020 - if (typ/=MAPL_Land .and. typ/=MAPL_Land + MAPL_ExcludeFromDomain) then ! exit if not land - - if (logit) then - write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' - write (logunit,*) ' Stop reading *.til file under the assumption that' - write (logunit,*) ' land tiles are first in *.til file.' - write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' - end if - - exit ! assuming land comes first in the til file - - end if - + if (all (tile_types == MAPL_LAND)) then + if (typ/=MAPL_Land .and. typ/=MAPL_Land + MAPL_ExcludeFromDomain ) then ! exit if not land + if (logit) then + write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' + write (logunit,*) ' Stop reading *.til file under the assumption that' + write (logunit,*) ' land tiles are first in *.til file.' + write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' + end if + exit ! assuming land comes first in the til file + endif + endif enddo close(10) - if(sum(landPosition) /= total_land) print*, "wrong counting of land" + if(sum(tilePosition) /= total_tile) print*, "wrong counting of land" do n=1,60 rates(n) = -0.3 + (n-1)*0.01 @@ -2293,39 +2293,39 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di ! 2) each process should have average land tiles - avg_land = ceiling(1.0*total_land/N_proc) - print*,"avg_land",avg_land + avg_tile = ceiling(1.0*total_tile/N_proc) + print*,"avg_tile",avg_tile - ! rate is used to readjust the avg_land + ! rate is used to readjust the avg_tile ! in case that the last processors don't have any land tiles, ! we can increase ther rates - avg_land = avg_land - nint(rate*avg_land) - print*,"re adjust the avg_land",avg_land + avg_tile = avg_tile - nint(rate*avg_tile) + print*,"re adjust the avg_tile",avg_tile tmpint = 0 local = 1 n0 = s-1 forward = .true. do n=s,e - tmpint=tmpint+landPosition(n) + tmpint=tmpint+tilePosition(n) if(local == N_proc .and. n < e) cycle ! all lefteover goes to the last process if( n==e ) then - local_land(local)=tmpint + local_tile(local)=tmpint IMS(local)=n-n0 exit endif - if( tmpint .ge. avg_land ) then + if( tmpint .ge. avg_tile ) then if (forward .or. n-n0 == 1 ) then - local_land(local)=tmpint + local_tile(local)=tmpint IMS(local)=n-n0 tmpint=0 n0=n forward = .false. else - local_land(local) = tmpint - landPosition(n) + local_tile(local) = tmpint - tilePosition(n) IMS(local)=(n-1)-n0 - tmpint= landPosition(n) + tmpint= tilePosition(n) n0 = n-1 forward = .true. endif @@ -2334,9 +2334,9 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di enddo print*,"rms rate: ", rms(rate) - print*,"land_distribute: ",local_land + print*,"tile_distribute: ",local_tile - if( sum(local_land) /= total_land) then + if( sum(local_tile) /= total_tile) then err_msg = 'wrong distribution' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if @@ -2397,36 +2397,36 @@ elemental function rms(rates) result (f) real,intent(in) :: rates integer :: tmpint,local integer :: n0,proc,n - integer :: avg_land - integer,allocatable :: local_land(:) + integer :: avg_tile + integer,allocatable :: local_tile(:) logical :: forward - allocate (local_land(N_proc)) - local_land = 0 - avg_land = ceiling(1.0*total_land/N_proc) - avg_land = avg_land -nint(rates*avg_land) + allocate (local_tile(N_proc)) + local_tile = 0 + avg_tile = ceiling(1.0*total_tile/N_proc) + avg_tile = avg_tile -nint(rates*avg_tile) forward = .true. tmpint = 0 local = 1 n0 = s-1 do n=s,e - tmpint=tmpint+landPosition(n) + tmpint=tmpint+tilePosition(n) if(local == N_proc .and. n < e) cycle ! all lefteover goes to the last process if( n==e ) then - local_land(local)=tmpint + local_tile(local)=tmpint exit endif - if( tmpint .ge. avg_land ) then + if( tmpint .ge. avg_tile ) then if (forward .or. n-n0 == 1 ) then - local_land(local)=tmpint + local_tile(local)=tmpint tmpint=0 n0=n forward = .false. else - local_land(local) = tmpint - landPosition(n) - tmpint= landPosition(n) + local_tile(local) = tmpint - tilePosition(n) + tmpint= tilePosition(n) n0 = n-1 forward = .true. endif @@ -2435,9 +2435,9 @@ elemental function rms(rates) result (f) enddo f = 0.0 do proc = 1, N_proc - f =max(f,1.0*abs(local_land(proc)-avg_land)) + f =max(f,1.0*abs(local_tile(proc)-avg_tile)) enddo - deallocate(local_land) + deallocate(local_tile) end function rms ! --------------------------------------------------- diff --git a/LDAS_Shared/LDAS_Convert.F90 b/LDAS_Shared/LDAS_Convert.F90 index 71b4acb9..5d1ae454 100644 --- a/LDAS_Shared/LDAS_Convert.F90 +++ b/LDAS_Shared/LDAS_Convert.F90 @@ -12,6 +12,7 @@ module LDAS_ConvertMod private public :: esmf2ldas + public :: string2tile_types interface esmf2ldas module procedure esmf2ldas_time @@ -46,4 +47,27 @@ subroutine esmf2ldas_time(esmf_dt, ldas_dt, rc) end subroutine esmf2ldas_time + ! delimiter "," + subroutine string2tile_types( string, tile_types) + character(len=ESMF_MAXSTR), intent(in) :: string + character(10), allocatable, intent(out) :: tile_types(:) + character(10) :: outs4(4) + integer :: ntype , j, j0 + j = index(string, ',') + ntype = 1 + j0 = 0 + do while (.true.) + if (j == 0) then + outs4(ntype) = trim(adjustl(string(j0+1:))) + exit + endif + outs4(ntype) = trim(adjustl(string(j0+1:j0+j-1))) + + j0 = j0+j + j = index(string(j0+1:), ',') + ntype = ntype+1 + enddo + allocate(tile_types(ntype), source=outs4(1:ntype)) + end subroutine string2tile_types + end module LDAS_ConvertMod From 7c16f21f713559e2c9e93ddca690b791d2f80e4c Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 16 Oct 2024 15:15:12 -0400 Subject: [PATCH 22/55] fix bug on setup --- GEOSldas_App/ldas_setup | 61 ++++++++++++++++---------------- GEOSldas_App/preprocess_ldas.F90 | 4 +-- 2 files changed, 33 insertions(+), 32 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index e4cf903b..7eaebb6d 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -298,29 +298,28 @@ class LDASsetup: # if _numg != _numd : # self.rqdExeInp['RST_FROM_GLOBAL'] = 0 - if self.with_land : - self.rqdExeInp['LNFM_FILE'] = '' - if int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1 : - self.rqdExeInp['TILING_FILE'] =glob.glob(self.bcs_geom + '*.til')[0] - self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] - self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] - tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') - if (len(tmp_) ==1) : - self.rqdExeInp['LNFM_FILE'] = tmp_[0] - self.rqdExeInp['NDVI_FILE'] = glob.glob(self.bcs_land + 'ndvi_clim_*.data')[0] - self.rqdExeInp['NIRDF_FILE']= glob.glob(self.bcs_land + 'nirdf_*.dat')[0] - self.rqdExeInp['VISDF_FILE']= glob.glob(self.bcs_land + 'visdf_*.dat')[0] - else : - inpdir=self.rqdExeInp['RESTART_PATH']+self.rqdExeInp['RESTART_ID']+'/input/' - self.rqdExeInp['TILING_FILE'] =os.path.realpath(glob.glob(inpdir+'*tile.data')[0]) - self.rqdExeInp['GRN_FILE']= os.path.realpath(glob.glob(inpdir+'green*data')[0]) - self.rqdExeInp['LAI_FILE']= os.path.realpath(glob.glob(inpdir+'lai*data')[0]) - tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') - if (len(tmp_) == 1) : - self.rqdExeInp['LNFM_FILE'] = tmp_[0] - self.rqdExeInp['NDVI_FILE']= os.path.realpath(glob.glob(inpdir+'ndvi*data')[0]) - self.rqdExeInp['NIRDF_FILE']= os.path.realpath(glob.glob(inpdir+'nirdf*data')[0]) - self.rqdExeInp['VISDF_FILE']= os.path.realpath(glob.glob(inpdir+'visdf*data')[0]) + self.rqdExeInp['LNFM_FILE'] = '' + if int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1 : + self.rqdExeInp['TILING_FILE'] =glob.glob(self.bcs_geom + '*.til')[0] + self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] + self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] + tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') + if (len(tmp_) ==1) : + self.rqdExeInp['LNFM_FILE'] = tmp_[0] + self.rqdExeInp['NDVI_FILE'] = glob.glob(self.bcs_land + 'ndvi_clim_*.data')[0] + self.rqdExeInp['NIRDF_FILE']= glob.glob(self.bcs_land + 'nirdf_*.dat')[0] + self.rqdExeInp['VISDF_FILE']= glob.glob(self.bcs_land + 'visdf_*.dat')[0] + else : + inpdir=self.rqdExeInp['RESTART_PATH']+self.rqdExeInp['RESTART_ID']+'/input/' + self.rqdExeInp['TILING_FILE'] =os.path.realpath(glob.glob(inpdir+'*tile.data')[0]) + self.rqdExeInp['GRN_FILE']= os.path.realpath(glob.glob(inpdir+'green*data')[0]) + self.rqdExeInp['LAI_FILE']= os.path.realpath(glob.glob(inpdir+'lai*data')[0]) + tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') + if (len(tmp_) == 1) : + self.rqdExeInp['LNFM_FILE'] = tmp_[0] + self.rqdExeInp['NDVI_FILE']= os.path.realpath(glob.glob(inpdir+'ndvi*data')[0]) + self.rqdExeInp['NIRDF_FILE']= os.path.realpath(glob.glob(inpdir+'nirdf*data')[0]) + self.rqdExeInp['VISDF_FILE']= os.path.realpath(glob.glob(inpdir+'visdf*data')[0]) if self.rqdExeInp['RESTART'].isdigit() : if int(self.rqdExeInp['RESTART']) == 2 : @@ -337,7 +336,7 @@ class LDASsetup: in_tilefiles_ = glob.glob(inpdir+'/*.til') self.in_tilefile =os.path.realpath(in_tilefiles_[0]) - if os.path.isfile(ldas_domain) and self.with_land : + if os.path.isfile(ldas_domain): _numd = int(linecache.getline(ldas_domain, 1).strip()) self.rqdExeInp['TILING_FILE'] =glob.glob(self.bcs_geom + '*.til')[0] self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] @@ -950,7 +949,7 @@ class LDASsetup: catchRstFile = glob.glob(self.exphome+'/'+exp_id+'/mk_restarts/*'+self.catch+'_internal_rst.'+YYYYMMDD+'*')[0] # catchment restart file - if os.path.isfile(catchRstFile and self.with_land) : + if os.path.isfile(catchRstFile) and self.with_land : catchLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.'+self.catch+'_internal_rst.'+y4m2d2_h2m2 if self.isZoomIn : print( "Creating local catchment restart file... \n") @@ -968,7 +967,7 @@ class LDASsetup: catchRstFile = catchRstFile0 # vegdyn restart file - if os.path.isfile(vegdynRstFile and self.with_land) : + if os.path.isfile(vegdynRstFile) and self.with_land : vegdynLocal = self.rstdir+ensdir +'/'+self.rqdExeInp['EXP_ID']+'.vegdyn_internal_rst' if self.isZoomIn : print ("Creating the local veg restart file... \n") @@ -986,7 +985,7 @@ class LDASsetup: vegdynRstFile = vegdynRstFile0 landiceRstFile = rstpath+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+'landice_internal_rst.'+y4m2d2_h2m2 - if os.path.isfile(landiceRstFile and self.with_landice) : + if os.path.isfile(landiceRstFile) and self.with_landice : landiceLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.landice_internal_rst.'+y4m2d2_h2m2 if self.isZoomIn : print ("Creating coom in landice restart file... \n") @@ -1016,7 +1015,7 @@ class LDASsetup: os.symlink(vegdynRstFile, myVegRst) if self.with_landice : print("link landice restart: " + myLandiceRst) - os.symlink(landiceRstFile, myLandiceRst) + os.symlink(landiceRstFile, myLandiceRst) if ( self.has_geos_pert and self.perturb == 1 ): os.symlink(pertRstFile, myPertRst) @@ -1227,8 +1226,10 @@ class LDASsetup: # avoid duplicate del ldasrcInp['VEGDYN_INTERNAL_RESTART_TYPE'] - rstkey.append(catch_).append('VEGDYN') - rstval.append(self.catch).append('vegdyn') + rstkey.append(catch_) + rstkey.append('VEGDYN') + rstval.append(self.catch) + rstval.append('vegdyn') if self.with_landice: rstkey.append('LANDICE') diff --git a/GEOSldas_App/preprocess_ldas.F90 b/GEOSldas_App/preprocess_ldas.F90 index 20e729a1..332a945d 100644 --- a/GEOSldas_App/preprocess_ldas.F90 +++ b/GEOSldas_App/preprocess_ldas.F90 @@ -46,7 +46,7 @@ program main character(len=512) :: f2g_file character(len=12 ) :: ymdhm character(len=12 ) :: SURFLAY - character(len=:), allocatable :: new_r, orig_r, tile_types + character(len=:), allocatable :: new_r, orig_r integer, allocatable :: int_types(:) call get_command_argument(1,option) @@ -173,7 +173,7 @@ subroutine get_tile_types(str_types, int_types) endif to = to + 1 enddo - read (unit=tile_types(from+1:to-1),fmt=*) int_types(n) + read (unit=str_types(from+1:to-1),fmt=*) int_types(n) end subroutine get_tile_types end program main From 7cf84b712539eee4b5c0721d866c7689425dc9f9 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 16 Oct 2024 15:24:38 -0400 Subject: [PATCH 23/55] first run and fix bug --- GEOS_LdasGridComp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 42d7bfa4..19b7d514 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -570,7 +570,7 @@ subroutine Initialize(gc, import, export, clock, rc) ! Create LAND's locstreams as subset of Surface locstream ! and add it to the children's MAPL objects - + allocate(mask(0)) if (with_land) then call MAPL_LocStreamCreate( & land_locstream, & @@ -580,7 +580,7 @@ subroutine Initialize(gc, import, export, clock, rc) rc=status & ) VERIFY_(status) - mask =[MAPL_LAND] + mask =[mask,MAPL_LAND] endif if (with_landice) then From ade5d1bc1d56fd82b8d1cbf16f1592e3133a958a Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 9 Dec 2024 09:26:48 -0500 Subject: [PATCH 24/55] exit with error code --- GEOSldas_App/lenkf_j_template.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSldas_App/lenkf_j_template.py b/GEOSldas_App/lenkf_j_template.py index f4ed07bc..91613269 100644 --- a/GEOSldas_App/lenkf_j_template.py +++ b/GEOSldas_App/lenkf_j_template.py @@ -454,7 +454,7 @@ set rc = -1 echo GEOSldas Run Status: $rc echo "ERROR: GEOSldas run FAILED, exit without post-processing" - exit + exit $rc endif From 66d1e7266472eda7bafa5f07dc51b7ea4906e91b Mon Sep 17 00:00:00 2001 From: "Lauren C. Andrews" Date: Wed, 19 Mar 2025 09:03:10 -0400 Subject: [PATCH 25/55] modifications to improve landice functionality --- GEOSldas_App/GEOSldas_HIST.rc | 43 +++++++++++++++++ GEOSldas_App/tile_bin2nc4.F90 | 76 +++++++++++++++++++++++++++++- LDAS_Shared/LDAS_RepairForcing.F90 | 4 +- 3 files changed, 120 insertions(+), 3 deletions(-) diff --git a/GEOSldas_App/GEOSldas_HIST.rc b/GEOSldas_App/GEOSldas_HIST.rc index ce692ffb..c7fcef33 100644 --- a/GEOSldas_App/GEOSldas_HIST.rc +++ b/GEOSldas_App/GEOSldas_HIST.rc @@ -25,6 +25,7 @@ COLLECTIONS: # 'inst3_2d_lndfcstana_Nx' # 'const_1d_lnd_Nt' # 'const_2d_lnd_Nx' +# 'tavg24_1d_glc_Nx' :: #CUBE GRID_LABELS: PC720x361-DC @@ -543,5 +544,47 @@ COLLECTIONS: 'TPSURF_ANA_ENSSTD' , 'LANDASSIM' , 'TSURF_ANA_ENSSTD' , 'TP1_ANA_ENSSTD' , 'LANDASSIM' , 'TSOIL1_ANA_ENSSTD' :: + + tavg24_1d_glc_Nx.descr: '2d,Daily,Time-Averaged,Single-Level,Land Ice Diagnostics', + tavg24_1d_glc_Nx.nbits: 12, + tavg24_1d_glc_Nx.template: '%y4%m2%d2_%h2%n2z.nc4' , + tavg24_1d_glc_Nx.mode: 'time-averaged' , + tavg24_1d_glc_Nx.frequency: 240000 , + tavg24_1d_glc_Nx.ref_time: 000000 , + tavg24_1d_glc_Nx.format: 'CFIO' , + tavg24_1d_glc_Nx.regrid_exch: '../input/tile.data' , + tavg24_1d_glc_Nx.regrid_name: 'PE180x1080-CF' , + tavg24_1d_glc_Nx.grid_label: PC720x361-DC , + tavg24_1d_glc_Nx.deflate: 1, + tavg24_1d_glc_Nx.fields: 'ACCUM' , 'LANDICE' , + 'ALBVR' , 'LANDICE' , + 'ALBVF' , 'LANDICE' , + 'ALBNR' , 'LANDICE' , + 'ALBNF' , 'LANDICE' , + 'ASNOW_GL' , 'LANDICE' , + 'DELTS' , 'LANDICE' , + 'DNICFLX' , 'LANDICE' , + 'EVAPOUT' , 'LANDICE' , + 'QH' , 'LANDICE' , + 'GHTSKIN' , 'LANDICE' , + 'HLATN' , 'LANDICE' , + 'IMELT' , 'LANDICE' , + 'LWNDSRF' , 'LANDICE' , + 'MELTWTR' , 'LANDICE' , + 'MELTWTRCONT' , 'LANDICE' , + 'RUNOFF' , 'LANDICE' , + 'SHOUT' , 'LANDICE' , + 'SMELT' , 'LANDICE' , + 'SNICEALB' , 'LANDICE' , + 'SNOMAS_GL' , 'LANDICE' , + 'SNOWALB' , 'LANDICE' , + 'SNOWDP_GL' , 'LANDICE' , + 'SWNDSRF' , 'LANDICE' , + 'TST' , 'LANDICE' , + 'WESNBOT' , 'LANDICE' , + 'WESNEXT' , 'LANDICE' , + 'WESNPERC' , 'LANDICE' , + 'WESNPREC' , 'LANDICE' , + :: # ========================== EOF ============================================================== diff --git a/GEOSldas_App/tile_bin2nc4.F90 b/GEOSldas_App/tile_bin2nc4.F90 index cf3f2fbc..196765fd 100644 --- a/GEOSldas_App/tile_bin2nc4.F90 +++ b/GEOSldas_App/tile_bin2nc4.F90 @@ -467,7 +467,81 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) case ('MWRTM_VEGOPACITY'); LONG_NAME = 'Lband_microwave_vegopacity_normalized_with_cos_inc_angle'; UNITS = '1' - ! default LONG_NAME and UNITS for nc4 files created by tile_bin2nc4.F90 (used for any SHORT_NAME not listed above): + ! land ice fields + + case ('EMIS'); LONG_NAME = 'surface_emissivity'; UNITS = '1' + ! case ('ALBVR'); LONG_NAME = 'surface_reflectivity_for_visible_beam'; UNITS = '1' + ! case ('ALBVF'); LONG_NAME = 'surface_reflectivity_for_visible_diffuse'; UNITS = '1' + ! case ('ALBNR'); LONG_NAME = 'surface_reflectivity_for_near_infrared_beam'; UNITS = '1' + ! case ('ALBNF'); LONG_NAME = 'surface_reflectivity_for_near_infrared_direct'; UNITS = '1' + case ('TST'); LONG_NAME = 'surface_temperature'; UNITS = 'K' + case ('QST'); LONG_NAME = 'surface_specific_humidity'; UNITS = 'kg kg-1' + case ('TH'); LONG_NAME = 'turbulence_surface_skin_temperature'; UNITS = 'K' + case ('QH'); LONG_NAME = 'turbulence_surface_specific_humidity'; UNITS = 'kg kg-1' + case ('DELTS'); LONG_NAME = 'change_of_surface_skin_temperature'; UNITS = 'K' + case ('DELQS'); LONG_NAME = 'change_of_surface_specific_humidity'; UNITS = 'kg kg-1' + case ('CHT'); LONG_NAME = 'surface_heat_exchange_coefficient'; UNITS = 'kg m-2 s-1' + case ('CMT'); LONG_NAME = 'surface_momentum_exchange_coefficient'; UNITS = 'kg m-2 s-1' + case ('CQT'); LONG_NAME = 'surface_moisture_exchange_coefficient'; UNITS = 'kg m-2 s-1' + case ('CNT'); LONG_NAME = 'neutral_drag_coefficient'; UNITS = '1' + case ('RIT'); LONG_NAME = 'surface_bulk_richardson_number'; UNITS = '1' + case ('ACCUM'); LONG_NAME = 'net_ice_accumulation_rate'; UNITS = 'kg m-2 s-1' + case ('EVPICE_GL'); LONG_NAME = 'snow_ice_evaporation_energy_flux_over_glaciated_surface'; UNITS = 'W m-2' + case ('SUBLIM'); LONG_NAME = 'sublimation'; UNITS = 'kg m-2 s-1' + case ('SNOMAS_GL'); LONG_NAME = 'snow_mass_over_glaciated_surface'; UNITS = 'kg m-2' + case ('SNOWDP_GL'); LONG_NAME = 'snow_depth_over_glaciated_surface'; UNITS = 'm' + case ('ASNOW_GL'); LONG_NAME = 'fractional_snow_covered_area_of_glaciated_surface'; UNITS = '1' + case ('RHOSNOW'); LONG_NAME = 'snow_layer_density'; UNITS = 'kg m-3' + case ('TSNOW'); LONG_NAME = 'snow_layer_temperature'; UNITS = 'K' + case ('TICE0'); LONG_NAME = 'aggregated_ice_layer_temperatured'; UNITS = 'K' + case ('WSNOW'); LONG_NAME = 'snow_laer_water_content'; UNITS = 'kg m-2' + case ('ZSNOW'); LONG_NAME = 'snow_layer_thickness'; UNITS = 'm' + case ('DRHS0'); LONG_NAME = 'snow_layer_density_change_due_to_densification'; UNITS = 'kg m-3' + case ('WESNEX'); LONG_NAME = 'snow_layer_mass_residual_due_to_densification'; UNITS = 'kg_m-2 s-1' + case ('WESNEXT'); LONG_NAME = 'total_snow_mass_residual_due_to_densification'; UNITS = 'kg m-2 s-1' + case ('WESNSC'); LONG_NAME = 'top_snow_layer_change_due_to_sub_con'; UNITS = 'kg m-2 s-1' + case ('SNDZSC'); LONG_NAME = 'top_snow_layer_thickness_change_due_to_sub_con'; UNITS = 'm s-1' + case ('WESNPREC'); LONG_NAME = 'top_snow_layer_mass_change_due_to_precip'; UNITS = 'kg_m-2 s-1' + case ('SNDZPREC'); LONG_NAME = 'top_snow_layer_thickness_change_due_to_precip'; UNITS = 'm s-1' + case ('SNDZ1PERC'); LONG_NAME = 'top_snow_layer_thickness_change_due_to_percolation'; UNITS = 'm s-1' + case ('WESNPERC'); LONG_NAME = 'snow_layer_mass_change_due_to_percolation'; UNITS = 'kg m-2 s-1' + case ('WESNDENS'); LONG_NAME = 'snow_layer_mass_change_due_to_densification'; UNITS = 'kg m-2 s-1' + case ('WESNREPAR'); LONG_NAME = 'snow_layer_mass_change_due_to_repartition'; UNITS = 'kg m-2 s-1' + case ('WESNBOT'); LONG_NAME = 'frozen_runoff_due_to_fixed_max_depth'; UNITS = 'kg m-2 s-1' + case ('RAINRFZ'); LONG_NAME = 'contribution_to_surface_mass_balance_from_rain_frozen_onto_bare_ice'; UNITS = 'kg m-2 s-1' + case ('SMELT'); LONG_NAME = 'snow_melt_flux'; UNITS = 'kg_m-2 s-1' + case ('IMELT'); LONG_NAME = 'ice_melt_flux'; UNITS = 'kg_m-2 s-1' + case ('SNOWALB'); LONG_NAME = 'snow_broadband_reflectivity'; UNITS = '1' + case ('SNICEALB'); LONG_NAME = 'aggregated_snow_ice_broadband_reflectivity'; UNITS = '1' + case ('MELTWTR'); LONG_NAME = 'melt_water_production'; UNITS = 'kg m-2 s-1' + case ('MELTWTRCONT'); LONG_NAME = 'snowpack_meltwater_content'; UNITS = 'kg m-2' + case ('LWC'); LONG_NAME = 'liquid_water_content_in_top_snow_layer'; UNITS = '1' + !case ('RUNOFF'); LONG_NAME = 'runoff_total_flux'; UNITS = 'kg m-2 s-1' + case ('GUST'); LONG_NAME = 'gustiness'; UNITS = 'm s-1' + case ('VENT'); LONG_NAME = 'surface_ventilation_velocity'; UNITS = 'm s-1' + case ('Z0'); LONG_NAME = 'surface_roughness'; UNITS = 'm' + case ('Z0H'); LONG_NAME = 'surface_roughness_for_heat'; UNITS = 'm' + case ('MOT2M'); LONG_NAME = 'temperature_2m_wind_from_MO_sfc'; UNITS = 'K' + case ('MOQ2M'); LONG_NAME = 'humidity_2m_wind_from_MO_sfc'; UNITS = 'kg kg-1' + case ('MOU2M'); LONG_NAME = 'zonal_2m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOV2M'); LONG_NAME = 'meridional_2m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOT10M'); LONG_NAME = 'temperature_10m_wind_from_MO_sfc'; UNITS = 'K' + case ('MOQ10M'); LONG_NAME = 'humidity_10m_wind_from_MO_sfc'; UNITS = 'kg kg-1' + case ('MOU10M'); LONG_NAME = 'zonal_10m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOV10M'); LONG_NAME = 'meridional_10m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOU50M'); LONG_NAME = 'zonal_50m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOV50M'); LONG_NAME = 'merodopma;_50m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('EVAPOUT'); LONG_NAME = 'evaporation'; UNITS = 'kg m-2 s-1' + case ('SHOUT'); LONG_NAME = 'upward_sensible_heat_flux'; UNITS = 'W m-2' + !case ('HLWUP'); LONG_NAME = 'surface_emitted_longwave_flux'; UNITS = 'W m-2' + case ('LWNDSRF'); LONG_NAME = 'surface_net_downward_longwave_flux'; UNITS = 'W m-2' + case ('SWNDSRF'); LONG_NAME = 'surface_net_downward_shortwave_flux'; UNITS = 'W m-2' + case ('HLATN'); LONG_NAME = 'total_latent_energy_flux'; UNITS = 'W m-2' + case ('DNICFLX'); LONG_NAME = 'downward_heat_flux_in_ice'; UNITS = 'W m-2' + case ('GHSNOW'); LONG_NAME = 'ground_heating_snow'; UNITS = 'W m-2' + !case ('GHTSKIN'); LONG_NAME = 'glacier_ice_heating_flux'; UNITS = 'W m-2' + +! default LONG_NAME and UNITS for nc4 files created by tile_bin2nc4.F90 (used for any SHORT_NAME not listed above): case default; LONG_NAME = 'not defined in tile_bin2nc4.F90'; UNITS = 'not defined in tile_bin2nc4.F90'; diff --git a/LDAS_Shared/LDAS_RepairForcing.F90 b/LDAS_Shared/LDAS_RepairForcing.F90 index 979e8fb2..52789b40 100644 --- a/LDAS_Shared/LDAS_RepairForcing.F90 +++ b/LDAS_Shared/LDAS_RepairForcing.F90 @@ -57,7 +57,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & ! min/max values for allowable range of forcing fields - real, parameter :: min_Tair = 190. ! [K] + real, parameter :: min_Tair = 180. ! [K] real, parameter :: max_Tair = 340. ! [K] real, parameter :: max_PSurf = 115000. ! [Pa] @@ -235,7 +235,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & ! NOTE: "warn" is turned on when repair_forcing is called first ! time after the forcing has been read from files - if ((warn) .and. (met_force(i)%Tair < 190.)) then + if ((warn) .and. (met_force(i)%Tair < min_Tair)) then write (tmpstr13a,'(e13.5)') met_force(i)%Tair ! convert real to string From d583768dd9cf24aca1b7f7ebec7d361535fe6b3f Mon Sep 17 00:00:00 2001 From: "Lauren C. Andrews" Date: Wed, 19 Mar 2025 09:49:16 -0400 Subject: [PATCH 26/55] changes to deconflict variable names --- GEOSldas_App/GEOSldas_HIST.rc | 13 +++++++------ GEOSldas_App/tile_bin2nc4.F90 | 14 +++++++------- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/GEOSldas_App/GEOSldas_HIST.rc b/GEOSldas_App/GEOSldas_HIST.rc index c7fcef33..784d29c7 100644 --- a/GEOSldas_App/GEOSldas_HIST.rc +++ b/GEOSldas_App/GEOSldas_HIST.rc @@ -557,22 +557,23 @@ COLLECTIONS: tavg24_1d_glc_Nx.grid_label: PC720x361-DC , tavg24_1d_glc_Nx.deflate: 1, tavg24_1d_glc_Nx.fields: 'ACCUM' , 'LANDICE' , - 'ALBVR' , 'LANDICE' , - 'ALBVF' , 'LANDICE' , - 'ALBNR' , 'LANDICE' , - 'ALBNF' , 'LANDICE' , + 'ALBVR' , 'LANDICE' , 'ALBVR_GL' , + 'ALBVF' , 'LANDICE' , 'ALBVF_GL' , + 'ALBNR' , 'LANDICE' , 'ALBNR_GL' , + 'ALBNF' , 'LANDICE' , 'ALBNF_GL' , 'ASNOW_GL' , 'LANDICE' , 'DELTS' , 'LANDICE' , 'DNICFLX' , 'LANDICE' , 'EVAPOUT' , 'LANDICE' , 'QH' , 'LANDICE' , - 'GHTSKIN' , 'LANDICE' , + 'GHTSKIN' , 'LANDICE' , 'GHTSKIN_GL' , 'HLATN' , 'LANDICE' , + 'HLWUP' , 'LANDICE' , 'HLWUP_GL' , 'IMELT' , 'LANDICE' , 'LWNDSRF' , 'LANDICE' , 'MELTWTR' , 'LANDICE' , 'MELTWTRCONT' , 'LANDICE' , - 'RUNOFF' , 'LANDICE' , + 'RUNOFF' , 'LANDICE' , 'RUNOFF_GL' , 'SHOUT' , 'LANDICE' , 'SMELT' , 'LANDICE' , 'SNICEALB' , 'LANDICE' , diff --git a/GEOSldas_App/tile_bin2nc4.F90 b/GEOSldas_App/tile_bin2nc4.F90 index 196765fd..72d05799 100644 --- a/GEOSldas_App/tile_bin2nc4.F90 +++ b/GEOSldas_App/tile_bin2nc4.F90 @@ -470,10 +470,10 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) ! land ice fields case ('EMIS'); LONG_NAME = 'surface_emissivity'; UNITS = '1' - ! case ('ALBVR'); LONG_NAME = 'surface_reflectivity_for_visible_beam'; UNITS = '1' - ! case ('ALBVF'); LONG_NAME = 'surface_reflectivity_for_visible_diffuse'; UNITS = '1' - ! case ('ALBNR'); LONG_NAME = 'surface_reflectivity_for_near_infrared_beam'; UNITS = '1' - ! case ('ALBNF'); LONG_NAME = 'surface_reflectivity_for_near_infrared_direct'; UNITS = '1' + case ('ALBVR_GL'); LONG_NAME = 'surface_reflectivity_for_visible_beam'; UNITS = '1' + case ('ALBVF_GL'); LONG_NAME = 'surface_reflectivity_for_visible_diffuse'; UNITS = '1' + case ('ALBNR_GL'); LONG_NAME = 'surface_reflectivity_for_near_infrared_beam'; UNITS = '1' + case ('ALBNF_GL'); LONG_NAME = 'surface_reflectivity_for_near_infrared_direct'; UNITS = '1' case ('TST'); LONG_NAME = 'surface_temperature'; UNITS = 'K' case ('QST'); LONG_NAME = 'surface_specific_humidity'; UNITS = 'kg kg-1' case ('TH'); LONG_NAME = 'turbulence_surface_skin_temperature'; UNITS = 'K' @@ -516,7 +516,7 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) case ('MELTWTR'); LONG_NAME = 'melt_water_production'; UNITS = 'kg m-2 s-1' case ('MELTWTRCONT'); LONG_NAME = 'snowpack_meltwater_content'; UNITS = 'kg m-2' case ('LWC'); LONG_NAME = 'liquid_water_content_in_top_snow_layer'; UNITS = '1' - !case ('RUNOFF'); LONG_NAME = 'runoff_total_flux'; UNITS = 'kg m-2 s-1' + case ('RUNOFF_GL'); LONG_NAME = 'runoff_total_flux'; UNITS = 'kg m-2 s-1' case ('GUST'); LONG_NAME = 'gustiness'; UNITS = 'm s-1' case ('VENT'); LONG_NAME = 'surface_ventilation_velocity'; UNITS = 'm s-1' case ('Z0'); LONG_NAME = 'surface_roughness'; UNITS = 'm' @@ -533,13 +533,13 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) case ('MOV50M'); LONG_NAME = 'merodopma;_50m_wind_from_MO_sfc'; UNITS = 'm s-1' case ('EVAPOUT'); LONG_NAME = 'evaporation'; UNITS = 'kg m-2 s-1' case ('SHOUT'); LONG_NAME = 'upward_sensible_heat_flux'; UNITS = 'W m-2' - !case ('HLWUP'); LONG_NAME = 'surface_emitted_longwave_flux'; UNITS = 'W m-2' + case ('HLWUP_GL'); LONG_NAME = 'surface_emitted_longwave_flux'; UNITS = 'W m-2' case ('LWNDSRF'); LONG_NAME = 'surface_net_downward_longwave_flux'; UNITS = 'W m-2' case ('SWNDSRF'); LONG_NAME = 'surface_net_downward_shortwave_flux'; UNITS = 'W m-2' case ('HLATN'); LONG_NAME = 'total_latent_energy_flux'; UNITS = 'W m-2' case ('DNICFLX'); LONG_NAME = 'downward_heat_flux_in_ice'; UNITS = 'W m-2' case ('GHSNOW'); LONG_NAME = 'ground_heating_snow'; UNITS = 'W m-2' - !case ('GHTSKIN'); LONG_NAME = 'glacier_ice_heating_flux'; UNITS = 'W m-2' + case ('GHTSKIN_GL'); LONG_NAME = 'glacier_ice_heating_flux'; UNITS = 'W m-2' ! default LONG_NAME and UNITS for nc4 files created by tile_bin2nc4.F90 (used for any SHORT_NAME not listed above): From 2d0a6950d4faa31072ff3a9fe54e87c6d704c260 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 24 Mar 2025 14:55:26 -0400 Subject: [PATCH 27/55] add support to read nc4 tile file from BCS --- GEOSldas_App/GEOSldas_LDAS.rc | 6 + GEOSldas_App/preprocess_ldas_routines.F90 | 561 +++++++++++++--------- 2 files changed, 333 insertions(+), 234 deletions(-) diff --git a/GEOSldas_App/GEOSldas_LDAS.rc b/GEOSldas_App/GEOSldas_LDAS.rc index df92fdb0..298cb8b3 100644 --- a/GEOSldas_App/GEOSldas_LDAS.rc +++ b/GEOSldas_App/GEOSldas_LDAS.rc @@ -36,6 +36,12 @@ CATCHMENT_SPINUP: 0 # LSM_CHOICE: 1 +# ---- Choice of tile types for the model +# There should not have space between types +# LAND,LANDICE +# +TILE_TYPES: LAND + # ---- Domain definition # diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 88ba2192..8431b216 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -497,6 +497,7 @@ subroutine domain_setup( & this_maxlon = tile_coord_r(n)%max_lon this_maxlat = tile_coord_r(n)%max_lat else ! c3 grid can straddle the lat-lon + ! WY Note: not sure if it is right this_minlon = tile_coord_r(n)%com_lon this_minlat = tile_coord_r(n)%com_lat this_maxlon = tile_coord_r(n)%com_lon @@ -1549,16 +1550,18 @@ subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) character(len=256) :: line - logical :: file_exist + logical :: file_exist, isNC4 integer, dimension(:),allocatable :: f2g, f2r,r2g, tile_types, N_tiles_r, N_tiles_f - integer :: n,stat, ty, N_types + integer :: n,stat, ty, N_types, nx, ny, file_type, status, n_grids, N_PfafCat integer :: N_tile, N_grid, g_id, f_id - + integer, allocatable :: IM(:), JM(:) + integer, allocatable :: iTable(:,:) + real(KIND=REAL64), allocatable :: rTable(:,:) + character(len=128), allocatable :: Gnames(:) character(len=4) :: typ_str, typ_str_exclude - character(len=*), parameter :: Iam = 'createZoominTilefile' inquire(file=trim(orig_tile),exist=file_exist) @@ -1571,60 +1574,84 @@ subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) return endif - open(40,file=trim(orig_tile),action="read") - open(50,file=trim(new_tile),action="write") - - ! copy the header back into the output tile file - ! (also corrects bug in EASE *.til files that have "N_grid=1" in line 2 but - ! still contain three additional lines for second grid definition) - do n=1,5 - read(40,'(A)') line - if(n==1) then - read(line,*) N_tile - endif - if(n==2) then - read(line,*) N_grid - endif - write(50,'(A)') trim(line) - enddo - if (N_grid==2) then - do n=1,3 - read(40,'(A)') line - write(50,'(A)') trim(line) - enddo - endif - g_id = 1 f_id = 1 f2g = r2g(f2r) - do while(.true.) - ! read one line of *.til file - read(40,'(A)',IOSTAT=stat) line - if(IS_IOSTAT_END(stat)) exit - ! extract first "integer" in "line" and put into "ty" - read(line,*) ty + + call MAPL_NCIOGetFileType(orig_tile, file_type, rc=status) + isNC4 = (file_type == MAPL_FILETYPE_NC4) + + if (isNC4) then + + call MAPL_ReadTilingNC4(orig_tile, n_grids = n_grids) + allocate(Gnames(n_grids), IM(n_grids), JM(n_grids)) + call MAPL_ReadTilingNC4(orig_tile, GridName=GNames, im=im, jm=jm, nx=nx, ny=ny,& + iTable=iTable, rTable=rTable, N_PfafCat=N_PfafCat, rc=status) + do n = 1, n_tile + if (any(tile_types == iTable(n,0))) then + if (f2g(f_id) /= n) then + iTable(n,0) = iTable(n,0) + MAPL_ExcludeFromDomain + else + f_id = f_id + 1 + if (f_id > size(f2g)) exit + endif + endif + enddo + + call MAPL_WriteTilingNc4(new_tile, gNames, im, jm, nx, ny, iTable, rTable, N_PfafCat=N_PfafCat, rc=status) + + else + open(40,file=trim(orig_tile),action="read") + open(50,file=trim(new_tile),action="write") - if( any( tile_types == ty)) then - ! here g_id is (consecutive) id of the global *land* tiles - if (f2g(f_id) /= g_id) then - ! if tile is not in Zoom in domain, replace ty in "line" with 1000+ty" - write(typ_str, '(I0)') ty - typ_str = adjustr(typ_str) - n=index(line, typ_str) - write(typ_str_exclude, '(I0)') ty + MAPL_ExcludeFromDomain - line(n:n+3) = typ_str_exclude - else - f_id = f_id + 1 - if (f_id > size(f2g)) f_id = 1 ! just set a number to prevent over flow, it would never come back here + ! copy the header back into the output tile file + ! (also corrects bug in EASE *.til files that have "N_grid=1" in line 2 but + ! still contain three additional lines for second grid definition) + do n=1,5 + read(40,'(A)') line + if(n==1) then + read(line,*) N_tile + endif + if(n==2) then + read(line,*) N_grid endif + write(50,'(A)') trim(line) + enddo + if (N_grid==2) then + do n=1,3 + read(40,'(A)') line + write(50,'(A)') trim(line) + enddo endif - ! write "line" into the output tile file - write(50,'(A)') trim(line) - g_id = g_id+1 - enddo - close(40) - close(50) - + + do while(.true.) + ! read one line of *.til file + read(40,'(A)',IOSTAT=stat) line + if(IS_IOSTAT_END(stat)) exit + ! extract first "integer" in "line" and put into "ty" + read(line,*) ty + + if( any( tile_types == ty)) then + ! here g_id is (consecutive) id of the global *land* tiles + if (f2g(f_id) /= g_id) then + ! if tile is not in Zoom in domain, replace ty in "line" with 1000+ty" + write(typ_str, '(I0)') ty + typ_str = adjustr(typ_str) + n=index(line, typ_str) + write(typ_str_exclude, '(I0)') ty + MAPL_ExcludeFromDomain + line(n:n+3) = typ_str_exclude + else + f_id = f_id + 1 + if (f_id > size(f2g)) f_id = 1 ! just set a number to prevent over flow, it would never come back here + endif + endif + ! write "line" into the output tile file + write(50,'(A)') trim(line) + g_id = g_id+1 + enddo + close(40) + close(50) + endif end subroutine createZoominTilefile ! ******************************************************************** @@ -1672,7 +1699,7 @@ subroutine createZoominRestart(mapping_file, orig_rst, new_rst, tile_type) character(*),intent(in):: orig_rst character(*),intent(in):: new_rst integer, intent(in) :: tile_type - integer :: istat, filetype, rc,i, j, ndims + integer :: istat, file_type, rc,i, j, ndims real,allocatable :: tmp1(:) type(Netcdf4_FileFormatter) :: InFmt,OutFmt type(FileMetadata) :: OutCfg @@ -1685,7 +1712,8 @@ subroutine createZoominRestart(mapping_file, orig_rst, new_rst, tile_type) character(len=:), pointer :: vname,dname integer ::n, N_r, N_f, N_types, r_starts, f_starts integer,dimension(:),allocatable :: f2r, r2g, f2r_, tile_types, N_tiles_r, N_tiles_f - + logical :: isNC4 + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) do n = 1, N_types @@ -1708,13 +1736,14 @@ subroutine createZoominRestart(mapping_file, orig_rst, new_rst, tile_type) ! check file type - call MAPL_NCIOGetFileType(orig_rst, filetype,rc=rc) - - if (filetype /= 0) then + call MAPL_NCIOGetFileType(orig_rst, file_type,rc=rc) + isNC4 = (file_type == MAPL_FILETYPE_NC4) + + if ( .not. isNC4 ) then print*, "Do not support binary restart" else - ! filetype = 0 : nc4 output file will also be nc4 + ! file_type = 0 : nc4 output file will also be nc4 call InFmt%open(trim(orig_rst), pFIO_READ,rc=rc) InCfg = InFmt%read(rc=rc) @@ -1791,7 +1820,7 @@ subroutine createZoominVegRestart(mapping_file, orig_veg, new_veg) integer :: N_catr, N_catf, N_types integer,dimension(:),allocatable :: f2r, r2g, f2r_land, tile_types, N_tiles_r, N_tiles_f - integer :: filetype + integer :: file_type type(Netcdf4_FileFormatter) :: InFmt,OutFmt type(FileMetadata) :: OutCfg type(FileMetadata) :: InCfg @@ -1800,7 +1829,8 @@ subroutine createZoominVegRestart(mapping_file, orig_veg, new_veg) type(StringVariableMapIterator) :: var_iter character(len=:), pointer :: vname integer :: rc - + logical :: isNC4 + call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) if (tile_types(1) /= MAPL_LAND) return @@ -1814,9 +1844,10 @@ subroutine createZoominVegRestart(mapping_file, orig_veg, new_veg) f2r_land = f2r(1:N_catf) - call MAPL_NCIOGetFileType(orig_veg, filetype,rc=rc) - - if (filetype /=0) then + call MAPL_NCIOGetFileType(orig_veg, file_type,rc=rc) + isNC4 = (file_type == MAPL_FILETYPE_NC4) + + if ( .not. isNC4 ) then open(10,file=trim(orig_veg),form='unformatted',action='read',status='old',iostat=istat) open(20,file=trim(new_veg),form='unformatted',action='write') read(10) rity @@ -2774,14 +2805,19 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, integer :: i, N_tile, N_grid,tmpint1, tmpint2, tmpint3, tmpint4 integer :: i_indg_offset, j_indg_offset, col_order integer :: N_tile_land, n_lon, n_lat - logical :: ease_grid - integer :: typ,k + logical :: ease_grid, isNC4 + integer :: typ, k, file_type, status integer, dimension(:), allocatable :: tile_types - + character(256) :: tmpline character(128) :: gridname character(512) :: fname + character(128), allocatable :: GNames(:) + integer, allocatable :: IM(:), JM(:) + integer, allocatable :: iTable(:,:) + real(KIND=REAL64), allocatable :: rTable(:,:) + character(len=*), parameter :: Iam = 'LDAS_read_til_file' ! --------------------------------------------------------------- @@ -2798,197 +2834,257 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! read *.til file header if (logit) write (logunit,'(400A)') trim(Iam), '(): reading from ' // trim(tile_file) + + ease_grid = .false. + col_order = 0 + + call MAPL_NCIOGetFileType(tile_file, file_type, rc=status) + isNC4 = (file_type == MAPL_FILETYPE_NC4) + + if (isNC4) then + call MAPL_ReadTilingNC4(tile_file, n_Grids=n_Grid, rc=status) + + allocate(GNames(n_grid), IM(n_grid), JM(n_grid)) + + call MAPL_ReadTilingNC4(tile_file, GridName=GNames, im=im, jm=jm, n_Grids=n_Grid, n_tiles=n_tile, & + iTable=iTable, rTable=rTable, N_PfafCat=N_catg, rc=status) + gridname = GNames(1) + n_lon = IM(1) + n_lat = JM(1) + + i =0 + allocate(r2g_tmp(N_tile)) + do k = 1, n_tile + if (any(tile_types == iTable(k,0))) then + i = i +1 + r2g_tmp(i) = k + endif + enddo + allocate(r2g, source = r2g_tmp(1:i)) + allocate(tile_coord_r(i)) + + + else - open (10, file=trim(tile_file), form='formatted', action='read') + open (10, file=trim(tile_file), form='formatted', action='read') - read (10,*) N_tile ! number of all tiles in *.til file, incl non-land types - read (10,*) N_grid - read (10,*) gridname - read (10,*) n_lon - read (10,*) n_lat + read (10,*) N_tile ! number of all tiles in *.til file, incl non-land types + read (10,*) N_grid + read (10,*) gridname + read (10,*) n_lon + read (10,*) n_lat + + ! NOTE: + ! There is a bug in at least some EASE *.til files through at least Icarus-NLv4. + ! Affected files state "N_grid=1" in line 2 of the header, but the header still includes + ! three additional lines for a second grid. + ! LDAS pre-processing corrects for this bug through subroutine correctEase() in + ! preprocess_LDAS.F90, which creates a second, corrected version of the *.til file during + ! ldas_setup. Here, this corrected *.til file is read! + + if(N_grid==2) then + read (10,*) ! some string describing ocean grid (?) + read (10,*) ! # ocean grid cells in longitude direction (N_i_ocn) (?) + read (10,*) ! # ocean grid cells in latitude direction (N_j_ocn) (?) + endif - ! NOTE: - ! There is a bug in at least some EASE *.til files through at least Icarus-NLv4. - ! Affected files state "N_grid=1" in line 2 of the header, but the header still includes - ! three additional lines for a second grid. - ! LDAS pre-processing corrects for this bug through subroutine correctEase() in - ! preprocess_LDAS.F90, which creates a second, corrected version of the *.til file during - ! ldas_setup. Here, this corrected *.til file is read! - - if(N_grid==2) then - read (10,*) ! some string describing ocean grid (?) - read (10,*) ! # ocean grid cells in longitude direction (N_i_ocn) (?) - read (10,*) ! # ocean grid cells in latitude direction (N_j_ocn) (?) + endif - ease_grid = .false. - col_order = 0 - call LDAS_create_grid_g( gridname, n_lon, n_lat, & - tile_grid_g, i_indg_offset, j_indg_offset, ease_cell_area ) - + tile_grid_g, i_indg_offset, j_indg_offset, ease_cell_area ) + if (index(tile_grid_g%gridtype,'EASE')/=0) ease_grid = .true. ! 'EASEv1' or 'EASEv2' if (index(tile_grid_g%gridtype,'SiB2')/=0) col_order=1 ! old bcs - allocate(tile_coord(N_tile)) - allocate(r2g_tmp(N_tile)) - - i = 0 - - ! WJ notes: i and k are the same---global ids - ! fid --- num in simulation domain - N_catg = 0 - do k=1,N_tile - - read(10,'(A)') tmpline - read(tmpline,*) typ - if (typ == MAPL_LAND .or. typ == MAPL_LAND + MAPL_ExcludeFromDomain) N_catg = N_catg + 1 - - ! tile type "MAPL_Land_ExcludeFromDomain" identifies land tiles to exclude - ! when non-global domain is created - - if (any( tile_types == typ)) then ! all needed tiles + if (isNC4 ) then + tile_coord_r(:)%typ = iTable(r2g, 0) + tile_coord_r(:)%i_indg = iTable(r2g, 2) + tile_coord_r(:)%j_indg = iTable(r2g, 3) + + tile_coord_r(:)%i_indg = tile_coord_r(:)%i_indg + i_indg_offset + tile_coord_r(:)%j_indg = tile_coord_r(:)%j_indg + j_indg_offset - i=i+1 - tile_coord(i)%tile_id = k - r2g_tmp(i) = k - - ! Not sure ".or. N_grid==1" will always work in the following conditional. - ! Some Tripolar grid *.til files may have N_grid=1. - ! - reichle, 2 Aug 2020 + if (N_grid == 1) then + tile_coord_r(:)%pfaf = iTable(r2g, 4) + else + tile_coord_r(:)%pfaf = iTable(r2g, 6) + endif + tile_coord_r(:)%com_lon = rTable(r2g, 1) + tile_coord_r(:)%com_lat = rTable(r2g, 2) + tile_coord_r(:)%area = rTable(r2g, 3) + tile_coord_r(:)%frac_cell = rTable(r2g, 4) + tile_coord_r(:)%min_lon = rTable(r2g, 6) + tile_coord_r(:)%max_lon = rTable(r2g, 7) + tile_coord_r(:)%min_lat = rTable(r2g, 8) + tile_coord_r(:)%max_lat = rTable(r2g, 9) + tile_coord_r(:)%elev = rTable(r2g, 10) + + tile_coord_r%frac_pfaf = nodata_generic + tile_coord_r%pert_i_indg = nint(nodata_generic) + tile_coord_r%pert_j_indg = nint(nodata_generic) + else + allocate(tile_coord(N_tile)) + allocate(r2g_tmp(N_tile)) + + i = 0 + + ! WJ notes: i and k are the same---global ids + ! fid --- num in simulation domain + N_catg = 0 + do k=1,N_tile - if (ease_grid .or. N_grid==1) then - - ! EASE grid til file has fewer columns - ! (excludes "tile_id", "frac_pfaf", and "area") - - read (tmpline,*) & - tile_coord(i)%typ, & ! 1 - tile_coord(i)%pfaf, & ! 2 - tile_coord(i)%com_lon, & ! 3 - tile_coord(i)%com_lat, & ! 4 - tile_coord(i)%i_indg, & ! 5 - tile_coord(i)%j_indg, & ! 6 - tile_coord(i)%frac_cell ! 7 - - tile_coord(i)%frac_pfaf = nodata_generic - - ! compute area of tile in [km^2] (units convention in tile_coord structure) - - tile_coord(i)%area = ease_cell_area*tile_coord(i)%frac_cell/1000./1000. ! [km^2] - - else ! not ease grid + read(10,'(A)') tmpline + read(tmpline,*) typ + + if (typ == MAPL_LAND .or. typ == MAPL_LAND + MAPL_ExcludeFromDomain) N_catg = N_catg + 1 + + ! tile type "MAPL_Land_ExcludeFromDomain" identifies land tiles to exclude + ! when non-global domain is created + + if (any( tile_types == typ)) then ! all needed tiles + + i=i+1 + tile_coord(i)%tile_id = k + r2g_tmp(i) = k + + ! Not sure ".or. N_grid==1" will always work in the following conditional. + ! Some Tripolar grid *.til files may have N_grid=1. + ! - reichle, 2 Aug 2020 - if (col_order==1) then + if (ease_grid .or. N_grid==1) then - ! old "SiB2_V2" file format - - read (tmpline,*) & - tile_coord(i)%typ, & ! 1 - tile_coord(i)%pfaf, & ! 2 * - tile_coord(i)%com_lon, & ! 3 - tile_coord(i)%com_lat, & ! 4 - tile_coord(i)%i_indg, & ! 5 - tile_coord(i)%j_indg, & ! 6 - tile_coord(i)%frac_cell, & ! 7 - tmpint1, & ! 8 - tmpint2, & ! 9 * - tmpint3, & ! 10 - tile_coord(i)%frac_pfaf, & ! 11 - tmpint4, & ! 12 (previously "tile_id") - tile_coord(i)%area ! 13 + ! EASE grid til file has fewer columns + ! (excludes "tile_id", "frac_pfaf", and "area") - else + read (tmpline,*) & + tile_coord(i)%typ, & ! 1 + tile_coord(i)%pfaf, & ! 2 + tile_coord(i)%com_lon, & ! 3 + tile_coord(i)%com_lat, & ! 4 + tile_coord(i)%i_indg, & ! 5 + tile_coord(i)%j_indg, & ! 6 + tile_coord(i)%frac_cell ! 7 - read (tmpline,*) & - tile_coord(i)%typ, & ! 1 - tile_coord(i)%area, & ! 2 * - tile_coord(i)%com_lon, & ! 3 - tile_coord(i)%com_lat, & ! 4 - tile_coord(i)%i_indg, & ! 5 - tile_coord(i)%j_indg, & ! 6 - tile_coord(i)%frac_cell, & ! 7 - tmpint1, & ! 8 - tile_coord(i)%pfaf, & ! 9 * - tmpint2, & ! 10 - tile_coord(i)%frac_pfaf, & ! 11 - tmpint3 ! 12 * (previously "tile_id") + tile_coord(i)%frac_pfaf = nodata_generic + + ! compute area of tile in [km^2] (units convention in tile_coord structure) + + tile_coord(i)%area = ease_cell_area*tile_coord(i)%frac_cell/1000./1000. ! [km^2] - ! change units of area to [km^2] - 23 Sep 2010: fixed units, reichle + else ! not ease grid - tile_coord(i)%area = tile_coord(i)%area*MAPL_RADIUS*MAPL_RADIUS/1000./1000. + if (col_order==1) then + + ! old "SiB2_V2" file format + + read (tmpline,*) & + tile_coord(i)%typ, & ! 1 + tile_coord(i)%pfaf, & ! 2 * + tile_coord(i)%com_lon, & ! 3 + tile_coord(i)%com_lat, & ! 4 + tile_coord(i)%i_indg, & ! 5 + tile_coord(i)%j_indg, & ! 6 + tile_coord(i)%frac_cell, & ! 7 + tmpint1, & ! 8 + tmpint2, & ! 9 * + tmpint3, & ! 10 + tile_coord(i)%frac_pfaf, & ! 11 + tmpint4, & ! 12 (previously "tile_id") + tile_coord(i)%area ! 13 + + else + + read (tmpline,*) & + tile_coord(i)%typ, & ! 1 + tile_coord(i)%area, & ! 2 * + tile_coord(i)%com_lon, & ! 3 + tile_coord(i)%com_lat, & ! 4 + tile_coord(i)%i_indg, & ! 5 + tile_coord(i)%j_indg, & ! 6 + tile_coord(i)%frac_cell, & ! 7 + tmpint1, & ! 8 + tile_coord(i)%pfaf, & ! 9 * + tmpint2, & ! 10 + tile_coord(i)%frac_pfaf, & ! 11 + tmpint3 ! 12 * (previously "tile_id") + + ! change units of area to [km^2] - 23 Sep 2010: fixed units, reichle + + tile_coord(i)%area = tile_coord(i)%area*MAPL_RADIUS*MAPL_RADIUS/1000./1000. + + end if ! col_order 1 - end if ! col_order 1 + end if ! (ease_grid) - end if ! (ease_grid) - - ! fix i_indg and j_indg such that they refer to a global grid - ! (see above) - - tile_coord(i)%i_indg = tile_coord(i)%i_indg + i_indg_offset - tile_coord(i)%j_indg = tile_coord(i)%j_indg + j_indg_offset - - !else ! WY note: keep reading untile the end of the file - - ! ! exit if not land - - ! if (logit) then - ! write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' - ! write (logunit,*) ' Stop reading *.til file under the assumption that' - ! write (logunit,*) ' land tiles are first in *.til file.' - ! write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' - ! end if - ! - ! exit ! assuming land comes first in the til file - - endif - - end do - - close(10) - ! i here is the number of restart nmuber including types in 'types') - allocate(r2g, source= r2g_tmp(1:i)) - allocate(tile_coord_r, source = tile_coord(1:i)) - deallocate(tile_coord) - deallocate(r2g_tmp) - ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing - tile_coord_r%pert_i_indg = nint(nodata_generic) - tile_coord_r%pert_j_indg = nint(nodata_generic) - call read_catchment_def( catch_file, N_catg, tile_coord_r ) - - ! ---------------------------------------------------------------------- - ! - ! if elevation info is still needed, read *gridded* elevation data (check only first tile!) - - ! gridded elevation file is NOT available for EASE grids, where elevation information - ! is in catchment.def file - - if ( tile_coord_r(1)%typ == MAPL_LAND .and. abs(tile_coord_r(1)%elev-nodata_generic)topo_DYN_ave.file') - open(10,file='topo_DYN_ave.file', action='read') - fname= '' - read(10,'(A)') fname + ! fix i_indg and j_indg such that they refer to a global grid + ! (see above) + + tile_coord(i)%i_indg = tile_coord(i)%i_indg + i_indg_offset + tile_coord(i)%j_indg = tile_coord(i)%j_indg + j_indg_offset + + !else ! WY note: keep reading untile the end of the file + + ! ! exit if not land + + ! if (logit) then + ! write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' + ! write (logunit,*) ' Stop reading *.til file under the assumption that' + ! write (logunit,*) ' land tiles are first in *.til file.' + ! write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' + ! end if + ! + ! exit ! assuming land comes first in the til file + + endif + + end do + close(10) - call read_grid_elev( trim(fname), tile_grid_g, N_tile_land, tile_coord_r ) - - end if - - if ( tile_coord_r(1)%typ == MAPL_LAND .and. abs(tile_coord_r(1)%elev-nodata_generic)topo_DYN_ave.file') + open(10,file='topo_DYN_ave.file', action='read') + fname= '' + read(10,'(A)') fname + close(10) + call read_grid_elev( trim(fname), tile_grid_g, N_tile, tile_coord_r ) + + end if + + if ( tile_coord_r(1)%typ == MAPL_LAND .and. abs(tile_coord_r(1)%elev-nodata_generic) Date: Mon, 7 Apr 2025 14:13:50 -0400 Subject: [PATCH 28/55] add tile_file_type --- GEOSldas_App/GEOSldas_LDAS.rc | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/GEOSldas_App/GEOSldas_LDAS.rc b/GEOSldas_App/GEOSldas_LDAS.rc index 298cb8b3..33a36903 100644 --- a/GEOSldas_App/GEOSldas_LDAS.rc +++ b/GEOSldas_App/GEOSldas_LDAS.rc @@ -42,6 +42,11 @@ LSM_CHOICE: 1 # TILE_TYPES: LAND +# ---- Choice of tile file types +# There are three choices : txt, nc4 or default +# If it is default, the type would be detected, or searched txt first +# +TILE_FILE_TYPE: default # ---- Domain definition # From 7cf936ee42465e3ec1214a9f34bd3a904381b7d2 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 8 Apr 2025 10:09:39 -0400 Subject: [PATCH 29/55] using nc4 tile file --- GEOSldas_App/GEOSldas_LDAS.rc | 4 +-- GEOSldas_App/ldas_setup | 32 ++++++++++++++++------- GEOSldas_App/preprocess_ldas_routines.F90 | 12 ++++++--- 3 files changed, 34 insertions(+), 14 deletions(-) diff --git a/GEOSldas_App/GEOSldas_LDAS.rc b/GEOSldas_App/GEOSldas_LDAS.rc index 33a36903..56be3eec 100644 --- a/GEOSldas_App/GEOSldas_LDAS.rc +++ b/GEOSldas_App/GEOSldas_LDAS.rc @@ -43,8 +43,8 @@ LSM_CHOICE: 1 TILE_TYPES: LAND # ---- Choice of tile file types -# There are three choices : txt, nc4 or default -# If it is default, the type would be detected, or searched txt first +# There are three choices : txt, nc4 and default +# If it is default, the type would be detected (searched txt first) # TILE_FILE_TYPE: default diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 427dd1f3..8202d331 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -299,8 +299,14 @@ class LDASsetup: # self.rqdExeInp['RST_FROM_GLOBAL'] = 0 self.rqdExeInp['LNFM_FILE'] = '' + tile_file_type = self.rqdExeInp.get('TILE_FILE_TYPE', 'default') if int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1 : - self.rqdExeInp['TILING_FILE'] =glob.glob(self.bcs_geom + '*.til')[0] + text_tile = glob.glob(self.bcs_geom + '*.til') + nc4_tile = glob.glob(self.bcs_geom + '*.nc4') + if tile_file_type.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] + if tile_file_type.upper() == 'NC4' : self.rqdExeInp['TILING_FILE'] = nc4_tile[0] + if tile_file_type.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[0] + self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') @@ -334,11 +340,19 @@ class LDASsetup: in_tilefiles_ = glob.glob(inpdir+'MAPL_*.til') if len(in_tilefiles_) == 0 : in_tilefiles_ = glob.glob(inpdir+'/*.til') + if len(in_tilefiles_) == 0 : + in_tilefiles_ = glob.glob(inpdir+'/*.nc4') + self.in_tilefile =os.path.realpath(in_tilefiles_[0]) if os.path.isfile(ldas_domain): _numd = int(linecache.getline(ldas_domain, 1).strip()) - self.rqdExeInp['TILING_FILE'] =glob.glob(self.bcs_geom + '*.til')[0] + text_tile = glob.glob(self.bcs_geom + '*.til') + nc4_tile = glob.glob(self.bcs_geom + '*.nc4') + if tile_file_type.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] + if tile_file_type.upper() == 'NC4' : self.rqdExeInp['TILING_FILE'] = nc4_tile[0] + if tile_file_type.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[0] + self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] tmp_ = glob.glob(self.bcs_land + 'lnfm_clim_*.data') @@ -350,9 +364,13 @@ class LDASsetup: self.rqdExeInp['VISDF_FILE']= glob.glob(self.bcs_land + 'visdf_*.dat')[0] if 'GRIDNAME' not in self.rqdExeInp : - tmptile =self.rqdExeInp['TILING_FILE'] - self.rqdExeInp['GRIDNAME'] = linecache.getline(tmptile, 3).strip() - + tmptile = os.path.realpath(self.rqdExeInp['TILING_FILE']) + if os.path.splitext(tmptile)[1] == '.til': + self.rqdExeInp['GRIDNAME'] = linecache.getline(tmptile, 3).strip() + else: + nc_tile = netCDF4.Dataset(tmptile,'r') + self.rqdExeInp['GRIDNAME'] = nc_file.getncattr('Grid_Name') + if 'LSM_CHOICE' not in self.rqdExeInp: self.rqdExeInp['LSM_CHOICE'] = 1 @@ -833,11 +851,7 @@ class LDASsetup: '/output/'+self.rqdExeInp['RESTART_DOMAIN']+'/rc_out/' # pass into remap_config_ldas - sponsorid = self.rqdRmInp['account'] exp_id = self.rqdExeInp['EXP_ID'] - exp_dir = self.exphome - out_bcdir = self.rqdExeInp['BCS_PATH'] - out_tilefile = self.rqdExeInp['TILING_FILE'] RESTART_str = str(self.rqdExeInp['RESTART']) YYYYMMDD = '%4d%02d%02d' % (_start.year, _start.month,_start.day) YYYYMMDDHH= '%4d%02d%02d%02d' % (_start.year, _start.month,_start.day, _start.hour) diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 8431b216..c6002cbd 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -1905,13 +1905,19 @@ subroutine correctEase(orig_ease,new_ease) implicit none character(*),intent(in) :: orig_ease character(*),intent(in) :: new_ease - logical :: file_exist,is_oldEASE - integer :: i, N_tile, N_grid + logical :: file_exist,is_oldEASE, isNC4 + integer :: i, N_tile, N_grid, file_type, status character(len=256) :: tmpline inquire(file=trim(orig_ease),exist=file_exist) if( .not. file_exist) stop (" no ease_tile_file") - + call MAPL_NCIOGetFileType(orig_ease, file_type, rc=status) + isNC4 = (file_type == MAPL_FILETYPE_NC4) + + if (isNC4) then + print*, "isNC4 tile file, no need to be corrected" + return + endif open(55,file=trim(orig_ease),action='read') read(55,*) N_tile read(55,*) N_grid From ca2fcf1e8882f57d4ae7c431bd80488a48c1d8dc Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 9 Apr 2025 09:29:12 -0400 Subject: [PATCH 30/55] fix typo --- GEOSldas_App/ldas_setup | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 8202d331..f630f583 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -13,6 +13,7 @@ import resource import subprocess as sp import shlex import tempfile +import netCDF4 from dateutil import rrule from datetime import datetime from datetime import timedelta @@ -301,7 +302,7 @@ class LDASsetup: self.rqdExeInp['LNFM_FILE'] = '' tile_file_type = self.rqdExeInp.get('TILE_FILE_TYPE', 'default') if int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1 : - text_tile = glob.glob(self.bcs_geom + '*.til') + txt_tile = glob.glob(self.bcs_geom + '*.til') nc4_tile = glob.glob(self.bcs_geom + '*.nc4') if tile_file_type.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] if tile_file_type.upper() == 'NC4' : self.rqdExeInp['TILING_FILE'] = nc4_tile[0] @@ -347,7 +348,7 @@ class LDASsetup: if os.path.isfile(ldas_domain): _numd = int(linecache.getline(ldas_domain, 1).strip()) - text_tile = glob.glob(self.bcs_geom + '*.til') + txt_tile = glob.glob(self.bcs_geom + '*.til') nc4_tile = glob.glob(self.bcs_geom + '*.nc4') if tile_file_type.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] if tile_file_type.upper() == 'NC4' : self.rqdExeInp['TILING_FILE'] = nc4_tile[0] From 6bf0c4e88dd7331ec477ee63c371301a449edb2d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 11 Apr 2025 15:49:23 -0400 Subject: [PATCH 31/55] fix bugs and optimization --- GEOSldas_App/ldas_setup | 10 +- GEOSldas_App/preprocess_ldas_routines.F90 | 327 +++++++++++----------- 2 files changed, 163 insertions(+), 174 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index f630f583..d51664f7 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -50,7 +50,7 @@ class LDASsetup: 'VISDF_FILE','CATCH_DEF_FILE','NDVI_FILE', 'NML_INPUT_PATH','HISTRC_FILE','RST_FROM_GLOBAL','JOB_SGMT','NUM_SGMT','POSTPROC_HIST', 'MINLON','MAXLON','MINLAT','MAXLAT','EXCLUDE_FILE','INCLUDE_FILE','MWRTM_PATH','GRIDNAME', - 'ADAS_EXPDIR', 'BCS_RESOLUTION' ] + 'ADAS_EXPDIR', 'BCS_RESOLUTION', 'TILE_FILE_TYPE' ] # if built on sles15, BUILT_ON_SLES15 is "TRUE", else empty "" BUILT_ON_SLES15 = "@BUILT_ON_SLES15@" @@ -366,10 +366,14 @@ class LDASsetup: if 'GRIDNAME' not in self.rqdExeInp : tmptile = os.path.realpath(self.rqdExeInp['TILING_FILE']) - if os.path.splitext(tmptile)[1] == '.til': + extension = os.path.splitext(tmptile)[1] + if extension == '.domain': + extension = os.path.splitext(tmptile)[0] + + if extension == '.til': self.rqdExeInp['GRIDNAME'] = linecache.getline(tmptile, 3).strip() else: - nc_tile = netCDF4.Dataset(tmptile,'r') + nc_file = netCDF4.Dataset(tmptile,'r') self.rqdExeInp['GRIDNAME'] = nc_file.getncattr('Grid_Name') if 'LSM_CHOICE' not in self.rqdExeInp: diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index c6002cbd..7f0244db 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -416,7 +416,7 @@ subroutine domain_setup( & ! locals - integer :: n, this_tileid, this_catpfaf, N_exclude, N_include, indomain, rc, N_tile_r, N_tile_f + integer :: n, this_tileid, this_catpfaf, N_exclude, N_include, indomain, rc, n_tiles_r, n_tiles_f integer, dimension(:), allocatable :: ExcludeList, IncludeList @@ -444,7 +444,7 @@ subroutine domain_setup( & ! try reading *domain.txt, *tilecoord.txt, and *tilegrids.txt files call io_domain_files( 'r', work_path, exp_id, & - N_tile_f, f2r, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) + n_tiles_f, f2r, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) if (rc==0) then ! read was successful @@ -485,12 +485,12 @@ subroutine domain_setup( & indomain = 0 ! initialize - N_tile_r = size(tile_coord_r) - allocate(tmp_f2r(N_tile_r)) - do n=1,N_tile_r + n_tiles_r = size(tile_coord_r) + allocate(tmp_f2r(n_tiles_r)) + do n=1,n_tiles_r this_tileid = tile_coord_r(n)%tile_id - + if( .not. c3_grid .and. tile_coord_r(n)%typ == MAPL_LAND) then this_minlon = tile_coord_r(n)%min_lon this_minlat = tile_coord_r(n)%min_lat @@ -523,14 +523,14 @@ subroutine domain_setup( & end do - N_tile_f = indomain + n_tiles_f = indomain - if (N_tile_f .eq. 0) then + if (n_tiles_f .eq. 0) then err_msg = 'No catchments found in domain' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) else if (logit) then - write (logunit,*) 'Number of tiles in domain = ', N_tile_f + write (logunit,*) 'Number of tiles in domain = ', n_tiles_f write (logunit,*) end if end if @@ -539,17 +539,17 @@ subroutine domain_setup( & ! ! assemble d2g, tile_coord, tile_grid_d - allocate(f2r( N_tile_f)) - allocate(tile_coord_f(N_tile_f)) + allocate(f2r( n_tiles_f)) + allocate(tile_coord_f(n_tiles_f)) - f2r(1:N_tile_f) = tmp_f2r(1:N_tile_f) + f2r(1:n_tiles_f) = tmp_f2r(1:n_tiles_f) tile_coord_f = tile_coord_r(f2r) ! finalize extent of actual domain: ! determine smallest subgrid of tile_grid_d that contains all ! catchments/tiles in domain - tile_grid_f = get_minExtent_grid( N_tile_f, tile_coord_f%i_indg, tile_coord_f%j_indg, & + tile_grid_f = get_minExtent_grid( n_tiles_f, tile_coord_f%i_indg, tile_coord_f%j_indg, & tile_coord_f%min_lon, tile_coord_f%min_lat, tile_coord_f%max_lon, tile_coord_f%max_lat, & tile_grid_g) @@ -558,7 +558,7 @@ subroutine domain_setup( & tmp_grid_def = tile_grid_g ! cannot use intent(in) tile_grid_g w/ io_domain_files call io_domain_files( 'w', work_path, exp_id, & - N_tile_f, f2r, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) + n_tiles_f, f2r, tile_coord_f, tmp_grid_def, tile_grid_f, rc ) end if ! domain/tilecoord/tilegrids files exist @@ -974,7 +974,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'done reading' if (logit) write (logunit,*) - + do k=1,N_catf ! this check works only for "SiB2_V2" and newer versions @@ -1554,13 +1554,13 @@ subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) integer, dimension(:),allocatable :: f2g, f2r,r2g, tile_types, N_tiles_r, N_tiles_f - integer :: n,stat, ty, N_types, nx, ny, file_type, status, n_grids, N_PfafCat + integer :: n,stat, ty, N_types, nx, ny, file_type, status, N_PfafCat - integer :: N_tile, N_grid, g_id, f_id - integer, allocatable :: IM(:), JM(:) + integer :: n_tiles, N_grids, g_id, f_id + integer :: IM(2), JM(2) integer, allocatable :: iTable(:,:) real(KIND=REAL64), allocatable :: rTable(:,:) - character(len=128), allocatable :: Gnames(:) + character(len=128) :: Gnames(2) character(len=4) :: typ_str, typ_str_exclude character(len=*), parameter :: Iam = 'createZoominTilefile' @@ -1583,11 +1583,9 @@ subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) if (isNC4) then - call MAPL_ReadTilingNC4(orig_tile, n_grids = n_grids) - allocate(Gnames(n_grids), IM(n_grids), JM(n_grids)) - call MAPL_ReadTilingNC4(orig_tile, GridName=GNames, im=im, jm=jm, nx=nx, ny=ny,& + call MAPL_ReadTilingNC4(orig_tile, GridName=GNames, im=im, jm=jm, nx=nx, ny=ny, n_grids = n_grids, n_tiles=n_tiles, & iTable=iTable, rTable=rTable, N_PfafCat=N_PfafCat, rc=status) - do n = 1, n_tile + do n = 1, n_tiles if (any(tile_types == iTable(n,0))) then if (f2g(f_id) /= n) then iTable(n,0) = iTable(n,0) + MAPL_ExcludeFromDomain @@ -1598,26 +1596,27 @@ subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) endif enddo - call MAPL_WriteTilingNc4(new_tile, gNames, im, jm, nx, ny, iTable, rTable, N_PfafCat=N_PfafCat, rc=status) + call MAPL_WriteTilingNc4(new_tile, gNames(1:n_grids), im(1:n_grids), jm(1:N_grids), & + nx, ny, iTable, rTable, N_PfafCat=N_PfafCat, rc=status) else open(40,file=trim(orig_tile),action="read") open(50,file=trim(new_tile),action="write") ! copy the header back into the output tile file - ! (also corrects bug in EASE *.til files that have "N_grid=1" in line 2 but + ! (also corrects bug in EASE *.til files that have "n_grids=1" in line 2 but ! still contain three additional lines for second grid definition) do n=1,5 read(40,'(A)') line if(n==1) then - read(line,*) N_tile + read(line,*) n_tiles endif if(n==2) then - read(line,*) N_grid + read(line,*) n_grids endif write(50,'(A)') trim(line) enddo - if (N_grid==2) then + if (n_grids==2) then do n=1,3 read(40,'(A)') line write(50,'(A)') trim(line) @@ -1893,7 +1892,7 @@ subroutine correctEase(orig_ease,new_ease) ! This subroutine corrects for a bug that is present in some EASE *.til files ! through at least Icarus-NLv4. - ! Affected files state "N_grid=1" in line 2 of the header, but the header still includes + ! Affected files state "n_grids=1" in line 2 of the header, but the header still includes ! three additional lines for a second grid, which throws off the canonical *.til reader ! (subroutine LDAS_read_til_file()). ! @@ -1906,7 +1905,7 @@ subroutine correctEase(orig_ease,new_ease) character(*),intent(in) :: orig_ease character(*),intent(in) :: new_ease logical :: file_exist,is_oldEASE, isNC4 - integer :: i, N_tile, N_grid, file_type, status + integer :: i, n_tiles, n_grids, file_type, status character(len=256) :: tmpline inquire(file=trim(orig_ease),exist=file_exist) @@ -1919,8 +1918,8 @@ subroutine correctEase(orig_ease,new_ease) return endif open(55,file=trim(orig_ease),action='read') - read(55,*) N_tile - read(55,*) N_grid + read(55,*) n_tiles + read(55,*) n_grids read(55,*) read(55,*) read(55,*) @@ -1928,7 +1927,7 @@ subroutine correctEase(orig_ease,new_ease) close(55) is_oldEASE= .false. - if(N_grid==1 .and. index(tmpline,'OCEAN')/=0) is_oldEASE=.true. + if(n_grids==1 .and. index(tmpline,'OCEAN')/=0) is_oldEASE=.true. if( is_oldEASE) then open(55,file=trim(orig_ease),action='read') @@ -1940,7 +1939,7 @@ subroutine correctEase(orig_ease,new_ease) read(55,*) read(55,*) read(55,*) - do i=1,N_tile + do i=1,n_tiles read(55,'(A)')tmpline write(56,'(A)')trim(tmpline) enddo @@ -1986,24 +1985,24 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di integer, optional, intent(in) :: types(:) ! local variables integer :: N_proc - integer :: N_tile,N_lon,N_lat,N_grid + integer :: n_tiles,N_lon,N_lat,n_grids integer,allocatable :: tilePosition(:) - integer,allocatable :: IMS(:),JMS(:) + integer,allocatable :: IMS(:),JMS(:), typs(:), II(:), JJ(:) integer,allocatable :: local_tile(:) integer :: total_tile integer :: n,typ,tmpint real :: tmpreal integer :: avg_tile,n0,local - integer :: i,s,e,j,k,n1,n2, s1, s2 + integer :: i,s,e,j,k,n1,n2, s1, s2, IM(2), JM(2) logical :: file_exist character(len=256):: tmpLine - character(len=128):: gridname + character(len=128):: gridname, gNames(2) real :: rate,rates(60),maxf(60) - integer :: IMGLOB, JMGLOB + integer :: IMGLOB, JMGLOB, file_type, status integer :: face(6),face_land(6) - logical :: forward + logical :: forward, isNC4 character(len=:), allocatable :: IMS_file, JMS_File - integer, allocatable :: tile_types(:) + integer, allocatable :: tile_types(:), iTable(:,:) character(len=*), parameter :: Iam = 'optimize_latlon' character(len=400) :: err_msg @@ -2023,14 +2022,28 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di err_msg = 'tile file does not exist: ' //trim(fname_tilefile) call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) end if + + call MAPL_NCIOGetFileType(trim(fname_tilefile), file_type, rc=status) + isNC4 = (file_type == MAPL_FILETYPE_NC4) - open (10, file=trim(fname_tilefile), form='formatted', action='read') - read (10,*) N_tile - read (10,*) N_grid ! some number (?) - read (10,*) gridname ! some string describing tile definition grid (?) - read (10,*) N_lon - read (10,*) n_lat - + if (isNC4) then + call MAPL_ReadTilingNC4(trim(fname_tilefile), GridName=GNames, im=im, jm=jm, n_Grids=n_grids, n_tiles=n_tiles, & + iTable=iTable, rc=status) + gridname = GNames(1) + n_lon = IM(1) + n_lat = JM(1) + + else + open (10, file=trim(fname_tilefile), form='formatted', action='read') + read (10,*) n_tiles + read (10,*) n_grids ! some number (?) + read (10,*) gridname ! some string describing tile definition grid (?) + read (10,*) N_lon + read (10,*) n_lat + endif + + allocate(typs(n_tiles), II(n_tiles), JJ(n_tiles)) + if (index(gridname,"CF") /=0) then ! cube-sphere tile space IMGLOB = N_lon ! e.g., 180 for c180 @@ -2043,48 +2056,41 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di allocate(tilePosition(JMGLOB)) tilePosition = 0 total_tile = 0 - - if(N_grid==2) then - read (10,*) ! some string describing ocean grid (?) - read (10,*) ! # ocean grid cells in longitude direction (N_i_ocn) (?) - read (10,*) - endif - - do n = 1,N_tile - read (10,*) & - typ, & ! 1 + + + if (.not. isNC4) then + if(n_grids==2) then + read (10,*) ! some string describing ocean grid (?) + read (10,*) ! # ocean grid cells in longitude direction (N_i_ocn) (?) + read (10,*) + endif + do n = 1, n_tiles + read (10,*) & + typs(n), & ! 1 tmpreal, & ! 2 * tmpreal, & ! 3 tmpreal, & ! 4 - i , & ! 5 - j ! 6 - !tmpreal, & ! 7 - !tmpint, & ! 8 - !tmpreal, & ! 9 * - !tmpint, & ! 10 - !tmpreal, & ! 11 - !tmpint ! 12 * (previously "tile_id") + ii(n) , & ! 5 + jj(n) ! 5 + enddo + close(10) + else + typs = iTable(:,0) + II = iTable(:,2) + JJ = iTable(:,3) + endif + + do n = 1,n_tiles + typ = typs(n) + i = II(n) + j = jj(n) if(any (tile_types == typ)) then total_tile=total_tile+1 tilePosition(j) = tilePosition(j)+1 endif - ! assume all land tiles are at the beginning - ! UNSAFE ASSUMPTION! - reichle, 2 Aug 2020 - if (all (tile_types == MAPL_LAND)) then - if (typ/=MAPL_Land .and. typ/=MAPL_Land + MAPL_ExcludeFromDomain) then ! exit if not land - if (logit) then - write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' - write (logunit,*) ' Stop reading *.til file under the assumption that' - write (logunit,*) ' land tiles are first in *.til file.' - write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' - end if - exit ! assuming land comes first in the til file - end if - endif enddo - close(10) if(mod(N_proc,6) /=0) then print*,"WARNING: ntasks should be adjusted to multiple of 6 for cubed-sphere grid :",N_proc @@ -2230,7 +2236,7 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di ! NOTE: ! There is a bug in at least some EASE *.til files through at least Icarus-NLv4. - ! Affected files state "N_grid=1" in line 2 of the header, but the header still includes + ! Affected files state "n_grids=1" in line 2 of the header, but the header still includes ! three additional lines for a second grid. ! ! The "else" block below corrects for this bug. @@ -2240,20 +2246,42 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di ! ldas_setup. ! ! -reichle, 2 Aug 2020 - - if(N_grid==2) then - read (10,*) ! some string describing ocean grid (?) - read (10,*) ! # ocean grid cells in longitude direction (N_i_ocn) (?) - read (10,*) - read(10,'(A)') tmpLine + + if (isNC4) then + + typs = iTable(:,0) + II = iTable(:,2) + JJ = iTable(:,3) else - read(10,'(A)') tmpLine - if (index(tmpLine,"OCEAN") /=0) then + if(n_grids==2) then read (10,*) ! some string describing ocean grid (?) read (10,*) ! # ocean grid cells in longitude direction (N_i_ocn) (?) read (10,*) read(10,'(A)') tmpLine + else + read(10,'(A)') tmpLine + if (index(tmpLine,"OCEAN") /=0) then + read (10,*) ! some string describing ocean grid (?) + read (10,*) ! # ocean grid cells in longitude direction (N_i_ocn) (?) + read (10,*) + read(10,'(A)') tmpLine + endif endif + read (tmpLine,*) & + typs(1), & ! 1 + tmpreal, & ! 2 * + tmpreal, & ! 3 + tmpreal, & ! 4 + ii(1) + do n=2, n_tiles + read (10,*) & + typs(n), & ! 1 + tmpreal, & ! 2 * + tmpreal, & ! 3 + tmpreal, & ! 4 + ii(n) ! 5 + enddo + close(10) endif if (index(gridname,'EASE') /=0) then @@ -2270,53 +2298,17 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di ! 1) read through tile file, put the land tile into the N_lon of bucket - read (tmpLine,*) & - typ, & ! 1 - tmpreal, & ! 2 * - tmpreal, & ! 3 - tmpreal, & ! 4 - i ! 5 - if (any(tile_types == typ)) then - total_tile=total_tile+1 - tilePosition(i) = tilePosition(i)+1 - endif - - do n = 2,N_tile - read (10,*) & - typ, & ! 1 - tmpreal, & ! 2 * - tmpreal, & ! 3 - tmpreal, & ! 4 - i ! 5 - !tmpint, & ! 6 - !tmpreal, & ! 7 - !tmpint, & ! 8 - !tmpreal, & ! 9 * - !tmpint, & ! 10 - !tmpreal, & ! 11 - !tmpint ! 12 * (previously "tile_id") + do n = 1,n_tiles + typ = typs(n) + i = II(n) + if (any(tile_types == typ)) then total_tile=total_tile+1 tilePosition(i) = tilePosition(i)+1 endif - ! assume all land tiles are at the beginning - ! UNSAFE ASSUMPTION! - reichle, 2 Aug 2020 - - if (all (tile_types == MAPL_LAND)) then - if (typ/=MAPL_Land .and. typ/=MAPL_Land + MAPL_ExcludeFromDomain ) then ! exit if not land - if (logit) then - write (logunit,*) 'WARNING: Encountered first non-land tile in *.til file.' - write (logunit,*) ' Stop reading *.til file under the assumption that' - write (logunit,*) ' land tiles are first in *.til file.' - write (logunit,*) ' This is NOT a safe assumption beyond Icarus-NLv[x] tile spaces!!' - end if - exit ! assuming land comes first in the til file - endif - endif enddo - close(10) if(sum(tilePosition) /= total_tile) print*, "wrong counting of land" @@ -2787,7 +2779,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! subroutine to match order of tiles in *.til file ! - reichle, 22 Aug 2013 ! - ! improved documentation of bug in some EASE *.til files (header says N_grid=1 but has two grid defs) + ! improved documentation of bug in some EASE *.til files (header says n_grids=1 but has two grid defs) ! and minor clean-up ! - reichle, 2 Aug 2020 ! @@ -2808,9 +2800,9 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, integer, dimension(:), allocatable :: r2g_tmp ! out real :: ease_cell_area - integer :: i, N_tile, N_grid,tmpint1, tmpint2, tmpint3, tmpint4 + integer :: i, n_tiles, n_grids,tmpint1, tmpint2, tmpint3, tmpint4 integer :: i_indg_offset, j_indg_offset, col_order - integer :: N_tile_land, n_lon, n_lat + integer :: n_tiles_land, n_lon, n_lat logical :: ease_grid, isNC4 integer :: typ, k, file_type, status integer, dimension(:), allocatable :: tile_types @@ -2819,8 +2811,8 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, character(128) :: gridname character(512) :: fname - character(128), allocatable :: GNames(:) - integer, allocatable :: IM(:), JM(:) + character(128) :: GNames(2) + integer :: IM(2), JM(2) integer, allocatable :: iTable(:,:) real(KIND=REAL64), allocatable :: rTable(:,:) @@ -2848,19 +2840,16 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, isNC4 = (file_type == MAPL_FILETYPE_NC4) if (isNC4) then - call MAPL_ReadTilingNC4(tile_file, n_Grids=n_Grid, rc=status) - - allocate(GNames(n_grid), IM(n_grid), JM(n_grid)) - call MAPL_ReadTilingNC4(tile_file, GridName=GNames, im=im, jm=jm, n_Grids=n_Grid, n_tiles=n_tile, & - iTable=iTable, rTable=rTable, N_PfafCat=N_catg, rc=status) + call MAPL_ReadTilingNC4(tile_file, GridName=GNames, im=im, jm=jm, n_Grids=n_grids, n_tiles=n_tiles, & + iTable=iTable, rTable=rTable, rc=status) gridname = GNames(1) n_lon = IM(1) n_lat = JM(1) i =0 - allocate(r2g_tmp(N_tile)) - do k = 1, n_tile + allocate(r2g_tmp(n_tiles)) + do k = 1, n_tiles if (any(tile_types == iTable(k,0))) then i = i +1 r2g_tmp(i) = k @@ -2868,32 +2857,30 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, enddo allocate(r2g, source = r2g_tmp(1:i)) allocate(tile_coord_r(i)) - - + deallocate(r2g_tmp) else open (10, file=trim(tile_file), form='formatted', action='read') - read (10,*) N_tile ! number of all tiles in *.til file, incl non-land types - read (10,*) N_grid + read (10,*) n_tiles ! number of all tiles in *.til file, incl non-land types + read (10,*) n_grids read (10,*) gridname read (10,*) n_lon read (10,*) n_lat ! NOTE: ! There is a bug in at least some EASE *.til files through at least Icarus-NLv4. - ! Affected files state "N_grid=1" in line 2 of the header, but the header still includes + ! Affected files state "n_grids=1" in line 2 of the header, but the header still includes ! three additional lines for a second grid. ! LDAS pre-processing corrects for this bug through subroutine correctEase() in ! preprocess_LDAS.F90, which creates a second, corrected version of the *.til file during ! ldas_setup. Here, this corrected *.til file is read! - if(N_grid==2) then + if(n_grids==2) then read (10,*) ! some string describing ocean grid (?) read (10,*) ! # ocean grid cells in longitude direction (N_i_ocn) (?) read (10,*) ! # ocean grid cells in latitude direction (N_j_ocn) (?) endif - endif @@ -2905,6 +2892,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, if (isNC4 ) then + N_catg = count(iTable(:,0) == MAPL_LAND .or. iTable(:,0) == (MAPL_LAND + MAPL_ExcludeFromDomain)) tile_coord_r(:)%typ = iTable(r2g, 0) tile_coord_r(:)%i_indg = iTable(r2g, 2) tile_coord_r(:)%j_indg = iTable(r2g, 3) @@ -2912,11 +2900,8 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, tile_coord_r(:)%i_indg = tile_coord_r(:)%i_indg + i_indg_offset tile_coord_r(:)%j_indg = tile_coord_r(:)%j_indg + j_indg_offset - if (N_grid == 1) then - tile_coord_r(:)%pfaf = iTable(r2g, 4) - else - tile_coord_r(:)%pfaf = iTable(r2g, 6) - endif + tile_coord_r(:)%tile_id = r2g + tile_coord_r(:)%pfaf = iTable(r2g, 4) tile_coord_r(:)%com_lon = rTable(r2g, 1) tile_coord_r(:)%com_lat = rTable(r2g, 2) tile_coord_r(:)%area = rTable(r2g, 3) @@ -2931,15 +2916,15 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, tile_coord_r%pert_i_indg = nint(nodata_generic) tile_coord_r%pert_j_indg = nint(nodata_generic) else - allocate(tile_coord(N_tile)) - allocate(r2g_tmp(N_tile)) + allocate(tile_coord(n_tiles)) + allocate(r2g_tmp(n_tiles)) i = 0 ! WJ notes: i and k are the same---global ids ! fid --- num in simulation domain N_catg = 0 - do k=1,N_tile + do k=1,n_tiles read(10,'(A)') tmpline read(tmpline,*) typ @@ -2955,11 +2940,11 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, tile_coord(i)%tile_id = k r2g_tmp(i) = k - ! Not sure ".or. N_grid==1" will always work in the following conditional. - ! Some Tripolar grid *.til files may have N_grid=1. + ! Not sure ".or. n_grids==1" will always work in the following conditional. + ! Some Tripolar grid *.til files may have n_grids=1. ! - reichle, 2 Aug 2020 - if (ease_grid .or. N_grid==1) then + if (ease_grid .or. n_grids==1) then ! EASE grid til file has fewer columns ! (excludes "tile_id", "frac_pfaf", and "area") @@ -3049,9 +3034,9 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, close(10) ! i here is the number of restart nmuber including types in 'types') - N_tile = i - allocate(r2g, source= r2g_tmp(1:n_tile)) - allocate(tile_coord_r, source = tile_coord(1:N_tile)) + n_tiles = i + allocate(r2g, source= r2g_tmp(1:n_tiles)) + allocate(tile_coord_r, source = tile_coord(1:n_tiles)) deallocate(tile_coord) deallocate(r2g_tmp) ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing @@ -3075,7 +3060,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, fname= '' read(10,'(A)') fname close(10) - call read_grid_elev( trim(fname), tile_grid_g, N_tile, tile_coord_r ) + call read_grid_elev( trim(fname), tile_grid_g, n_tiles, tile_coord_r ) end if @@ -3090,13 +3075,13 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! fix dateline bug that existed up to and including MERRA version of ! *.til and catchment.def files - call fix_dateline_bug_in_tilecoord( N_tile, tile_grid_g, tile_coord_r ) + call fix_dateline_bug_in_tilecoord( n_tiles, tile_grid_g, tile_coord_r ) contains ! ************************************************************************************* - subroutine read_grid_elev( fname, tile_grid, N_tile, tile_coord ) + subroutine read_grid_elev( fname, tile_grid, n_tiles, tile_coord ) ! read gridded elevation file (for GEOS-5 discretizations; NOT available ! for EASE grids, where elevation information is in catchment.def file) @@ -3108,7 +3093,7 @@ subroutine read_grid_elev( fname, tile_grid, N_tile, tile_coord ) character(*), intent(in) :: fname type(grid_def_type), intent(in) :: tile_grid - integer, intent(in) :: N_tile + integer, intent(in) :: n_tiles type(tile_coord_type), dimension(:), pointer :: tile_coord ! inout ! local variables @@ -3150,7 +3135,7 @@ subroutine read_grid_elev( fname, tile_grid, N_tile, tile_coord ) ! map elevation to tiles - do i=1,N_tile + do i=1,n_tiles tile_coord(i)%elev = grid_elev( tile_coord(i)%i_indg, tile_coord(i)%j_indg ) @@ -3159,7 +3144,7 @@ subroutine read_grid_elev( fname, tile_grid, N_tile, tile_coord ) end subroutine read_grid_elev ! ******************************************************************* - subroutine fix_dateline_bug_in_tilecoord( N_tile, tile_grid, tile_coord ) + subroutine fix_dateline_bug_in_tilecoord( n_tiles, tile_grid, tile_coord ) ! bug in com_lon and minlon/maxlon for tiles straddling the dateline ! existed through (and including) MERRA tag @@ -3170,7 +3155,7 @@ subroutine fix_dateline_bug_in_tilecoord( N_tile, tile_grid, tile_coord ) implicit none - integer, intent(in) :: N_tile + integer, intent(in) :: n_tiles type(grid_def_type), intent(in) :: tile_grid @@ -3191,7 +3176,7 @@ subroutine fix_dateline_bug_in_tilecoord( N_tile, tile_grid, tile_coord ) if ( (tile_grid%ll_lon<-180.) .and. & (.not. (tile_grid%ll_lon-nodata_generic) Date: Fri, 11 Apr 2025 15:52:15 -0400 Subject: [PATCH 32/55] change log --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ecf462fd..d9b07443 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added +- Added function to read nc4 tile file - Added landice grid comp - New update_type for joint 3d soil moisture and 1d snow analysis (Tb+sfmc+sfds+SCF obs) From 17f376ce6b8e7e4a6562589b679b6e9e4aa27946 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 24 Apr 2025 16:02:08 -0400 Subject: [PATCH 33/55] fix RESTART=M --- GEOSldas_App/ldas_setup | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index c7568cbf..d18be773 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -882,7 +882,8 @@ class LDASsetup: config['input']['surface']['catch_tilefile'] = self.in_tilefile config['input']['shared']['expid'] = self.rqdExeInp['RESTART_ID'] config['input']['shared']['yyyymmddhh'] = YYYYMMDDHH - config['input']['shared']['rst_dir'] = os.path.dirname(self.in_rstfile)+'/' + if RESTART_str == '2' : + config['input']['shared']['rst_dir'] = os.path.dirname(self.in_rstfile)+'/' config['input']['surface']['wemin'] = wemin_in config['input']['surface']['catch_model'] = self.catch @@ -921,6 +922,8 @@ class LDASsetup: config['input']['shared']['agrid'] = 'C180' config['input']['shared']['ogrid'] = '1440x720' config['input']['shared']['omodel'] = 'data' + config['input']['shared']['MERRA-2'] = True + config['input']['surface']['catch_tilefile'] = '/discover/nobackup/projects/gmao/bcs_shared/fvInput/ExtData/esm/tiles/GM4/geometry/CF0180x6C_DE1440xPE0720/CF0180x6C_DE1440xPE0720-Pfafstetter.til' catch_obj = catchANDcn(config_obj = config) catch_obj.remap() From 1b8202a4161987e0d0140c903cae5ccf63204bdf Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 25 Apr 2025 13:11:19 -0400 Subject: [PATCH 34/55] fix RESTART=M option for landice --- GEOSldas_App/ldas_setup | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 9ff27b90..9f995e53 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -21,6 +21,7 @@ from collections import OrderedDict from dateutil.relativedelta import relativedelta from remap_utils import * from remap_catchANDcn import * +from remap_lake_landice_saltwater import * from lenkf_j_template import * """ This script is intended to be run from any installed directory with GEOSldas.x and ldas_setup @@ -895,8 +896,7 @@ class LDASsetup: config['input']['surface']['catch_tilefile'] = self.in_tilefile config['input']['shared']['expid'] = self.rqdExeInp['RESTART_ID'] config['input']['shared']['yyyymmddhh'] = YYYYMMDDHH - if RESTART_str == '2' : - config['input']['shared']['rst_dir'] = os.path.dirname(self.in_rstfile)+'/' + config['input']['shared']['rst_dir'] = os.path.dirname(self.in_rstfile)+'/' config['input']['surface']['wemin'] = wemin_in config['input']['surface']['catch_model'] = self.catch @@ -940,6 +940,11 @@ class LDASsetup: catch_obj = catchANDcn(config_obj = config) catch_obj.remap() + if (self.with_landice): + config['output']['surface']['remap_water'] = True + config['input']['surface']['zoom'] = '2' + landice_obj = lake_landice_saltwater(config_obj = config) + landice_obj.remap() #for ens in self.ensdirs : catchRstFile0 = '' @@ -1009,8 +1014,16 @@ class LDASsetup: else : vegdynRstFile = vegdynRstFile0 - landiceRstFile = rstpath+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+'landice_internal_rst.'+y4m2d2_h2m2 - if os.path.isfile(landiceRstFile) and self.with_landice : + landiceRstFile = '' + if self.with_landice : + if self.rqdExeInp['RESTART'].isdigit(): + if int(self.rqdExeInp['RESTART']) == 0 or int(self.rqdExeInp['RESTART']) == 2 : + print(" landice type does not support REATART=0 or 2 option. please use M option(MERRA-2)") + landiceRstFile = rstpath+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+'landice_internal_rst.'+y4m2d2_h2m2 + else: + landiceRstFile = glob.glob(self.exphome+'/'+exp_id+'/mk_restarts/*'+'landice_internal_rst.'+YYYYMMDD+'*')[0] + + if os.path.isfile(landiceRstFile) : landiceLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.landice_internal_rst.'+y4m2d2_h2m2 if self.isZoomIn : print ("Creating coom in landice restart file... \n") From d72b052b7f24ec9fac9397ae81d8fd081fe2b52f Mon Sep 17 00:00:00 2001 From: "Lauren C. Andrews" Date: Tue, 29 Apr 2025 14:26:16 -0400 Subject: [PATCH 35/55] modifications to tile+gridded landice diag. --- GEOSldas_App/GEOSldas_HIST.rc | 51 ++++++++++++++++++++++++++--------- 1 file changed, 38 insertions(+), 13 deletions(-) diff --git a/GEOSldas_App/GEOSldas_HIST.rc b/GEOSldas_App/GEOSldas_HIST.rc index 784d29c7..a484888e 100644 --- a/GEOSldas_App/GEOSldas_HIST.rc +++ b/GEOSldas_App/GEOSldas_HIST.rc @@ -25,7 +25,8 @@ COLLECTIONS: # 'inst3_2d_lndfcstana_Nx' # 'const_1d_lnd_Nt' # 'const_2d_lnd_Nx' -# 'tavg24_1d_glc_Nx' +# 'tavg24_2d_glc_Nx' +# 'tavg24_1d_glc_Nt' :: #CUBE GRID_LABELS: PC720x361-DC @@ -545,18 +546,18 @@ COLLECTIONS: 'TP1_ANA_ENSSTD' , 'LANDASSIM' , 'TSOIL1_ANA_ENSSTD' :: - tavg24_1d_glc_Nx.descr: '2d,Daily,Time-Averaged,Single-Level,Land Ice Diagnostics', - tavg24_1d_glc_Nx.nbits: 12, - tavg24_1d_glc_Nx.template: '%y4%m2%d2_%h2%n2z.nc4' , - tavg24_1d_glc_Nx.mode: 'time-averaged' , - tavg24_1d_glc_Nx.frequency: 240000 , - tavg24_1d_glc_Nx.ref_time: 000000 , - tavg24_1d_glc_Nx.format: 'CFIO' , - tavg24_1d_glc_Nx.regrid_exch: '../input/tile.data' , - tavg24_1d_glc_Nx.regrid_name: 'PE180x1080-CF' , - tavg24_1d_glc_Nx.grid_label: PC720x361-DC , - tavg24_1d_glc_Nx.deflate: 1, - tavg24_1d_glc_Nx.fields: 'ACCUM' , 'LANDICE' , + tavg24_2d_glc_Nx.descr: '2d,Daily,Time-Averaged,Single-Level,Land Ice Diagnostics', + tavg24_2d_glc_Nx.nbits: 12, + tavg24_2d_glc_Nx.template: '%y4%m2%d2_%h2%n2z.nc4' , + tavg24_2d_glc_Nx.mode: 'time-averaged' , + tavg24_2d_glc_Nx.frequency: 240000 , + tavg24_2d_glc_Nx.ref_time: 000000 , + tavg24_2d_glc_Nx.format: 'CFIO' , + tavg24_2d_glc_Nx.regrid_exch: '../input/tile.data' , + tavg24_2d_glc_Nx.regrid_name: 'GRIDNAME' , + tavg24_2d_glc_Nx.grid_label: PC720x361-DC , #comment this line out for cube face output + tavg24_2d_glc_Nx.deflate: 1, + tavg24_2d_glc_Nx.fields: 'ACCUM' , 'LANDICE' , 'ALBVR' , 'LANDICE' , 'ALBVR_GL' , 'ALBVF' , 'LANDICE' , 'ALBVF_GL' , 'ALBNR' , 'LANDICE' , 'ALBNR_GL' , @@ -588,4 +589,28 @@ COLLECTIONS: 'WESNPREC' , 'LANDICE' , :: + tavg24_1d_glc_Nt.descr: 'Tile-space, Daily, Time-Averaged, Single-level,Land Ice Outputs', + tavg24_1d_glc_Nt.nbits: 12, + tavg24_1d_glc_Nt.template: '%y4%m2%d2_%h2%n2z.bin' , + tavg24_1d_glc_Nt.mode: 'time-averaged' , + tavg24_1d_glc_Nt.frequency: 240000 , + tavg24_1d_glc_Nt.ref_time: 000000 , + tavg24_1d_glc_Nt.fields: 'ASNOW_GL' , 'LANDICE' , + 'DELTS' , 'LANDICE' , + 'EVAPOUT' , 'LANDICE' , + 'GHTSKIN' , 'LANDICE' , 'GHTSKIN_GL' , + 'HLATN' , 'LANDICE' , + 'HLWUP' , 'LANDICE' , 'HLWUP_GL' , + 'LWNDSRF' , 'LANDICE' , + 'MELTWTR' , 'LANDICE' , + 'MELTWTRCONT' , 'LANDICE' , + 'RUNOFF' , 'LANDICE' , 'RUNOFF_GL' , + 'SHOUT' , 'LANDICE' , + 'SNOMAS_GL' , 'LANDICE' , + 'SNOWDP_GL' , 'LANDICE' , + 'SWNDSRF' , 'LANDICE' , + 'TST' , 'LANDICE' , + 'WESNBOT' , 'LANDICE' , + 'WESNEXT' , 'LANDICE' , + :: # ========================== EOF ============================================================== From fe23430794737c6732ca225694c523e2930ee6d1 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 30 Apr 2025 11:55:44 -0400 Subject: [PATCH 36/55] default tile file would be nc4 --- GEOSldas_App/GEOSldas_LDAS.rc | 2 +- GEOSldas_App/ldas_setup | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/GEOSldas_App/GEOSldas_LDAS.rc b/GEOSldas_App/GEOSldas_LDAS.rc index 56be3eec..14014fdc 100644 --- a/GEOSldas_App/GEOSldas_LDAS.rc +++ b/GEOSldas_App/GEOSldas_LDAS.rc @@ -44,7 +44,7 @@ TILE_TYPES: LAND # ---- Choice of tile file types # There are three choices : txt, nc4 and default -# If it is default, the type would be detected (searched txt first) +# If it is default, the type would be detected (searched nc4 first) # TILE_FILE_TYPE: default diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 9f995e53..7ac1c4f7 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -314,7 +314,7 @@ class LDASsetup: nc4_tile = glob.glob(self.bcs_geom + '*.nc4') if tile_file_type.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] if tile_file_type.upper() == 'NC4' : self.rqdExeInp['TILING_FILE'] = nc4_tile[0] - if tile_file_type.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[0] + if tile_file_type.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[-1] self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] @@ -360,7 +360,7 @@ class LDASsetup: nc4_tile = glob.glob(self.bcs_geom + '*.nc4') if tile_file_type.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] if tile_file_type.upper() == 'NC4' : self.rqdExeInp['TILING_FILE'] = nc4_tile[0] - if tile_file_type.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[0] + if tile_file_type.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[-1] self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] From 3b67b4990901323eae561d1257bbc00fe9bc4da1 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 30 Apr 2025 12:03:02 -0400 Subject: [PATCH 37/55] set default elevation to nodata_generic --- GEOSldas_App/preprocess_ldas_routines.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index fc099811..eccefd96 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -3042,6 +3042,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing tile_coord_r%pert_i_indg = nint(nodata_generic) tile_coord_r%pert_j_indg = nint(nodata_generic) + tile_coord_r%elev = nodata_generic call read_catchment_def( catch_file, N_catg, tile_coord_r ) ! ---------------------------------------------------------------------- From 85849a3ebb5c6cd4cd9369f0ddfc5ba1c292620a Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Apr 2025 12:50:53 -0400 Subject: [PATCH 38/55] minor cleanup of previous commits (GEOSldas_LDAS.rc, ldas_setup, preprocess_ldas_routines.F90) - changed rc variable name from TILE_FILE_TYPE to TILE_FILE_FORMAT - removed obsolete NC4 option for TILE_FILE_FORMAT - changed variable name N_catg to N_tiles_land_g inside subroutine LDAS_read_til_file() - corrected & clarifed comments --- GEOSldas_App/GEOSldas_LDAS.rc | 12 ++++--- GEOSldas_App/ldas_setup | 16 ++++----- GEOSldas_App/preprocess_ldas_routines.F90 | 40 +++++++++++++---------- 3 files changed, 38 insertions(+), 30 deletions(-) diff --git a/GEOSldas_App/GEOSldas_LDAS.rc b/GEOSldas_App/GEOSldas_LDAS.rc index 14014fdc..15c1538c 100644 --- a/GEOSldas_App/GEOSldas_LDAS.rc +++ b/GEOSldas_App/GEOSldas_LDAS.rc @@ -36,17 +36,21 @@ CATCHMENT_SPINUP: 0 # LSM_CHOICE: 1 + # ---- Choice of tile types for the model # There should not have space between types # LAND,LANDICE # TILE_TYPES: LAND -# ---- Choice of tile file types -# There are three choices : txt, nc4 and default -# If it is default, the type would be detected (searched nc4 first) + +# ---- Choice of tile file format (from bcs directory) +# +# DEFAULT : Use nc4 tile file if it exists, txt tile file otherwise +# TXT : Use txt tile file (e.g., for 0-diff testing) # -TILE_FILE_TYPE: default +TILE_FILE_FORMAT: default + # ---- Domain definition # diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 7ac1c4f7..923ee879 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -51,7 +51,7 @@ class LDASsetup: 'VISDF_FILE','CATCH_DEF_FILE','NDVI_FILE', 'NML_INPUT_PATH','HISTRC_FILE','RST_FROM_GLOBAL','JOB_SGMT','NUM_SGMT','POSTPROC_HIST', 'MINLON','MAXLON','MINLAT','MAXLAT','EXCLUDE_FILE','INCLUDE_FILE','MWRTM_PATH','GRIDNAME', - 'ADAS_EXPDIR', 'BCS_RESOLUTION', 'TILE_FILE_TYPE' ] + 'ADAS_EXPDIR', 'BCS_RESOLUTION', 'TILE_FILE_FORMAT' ] self.GEOS_SITE = "@GEOS_SITE@" @@ -308,13 +308,12 @@ class LDASsetup: # self.rqdExeInp['RST_FROM_GLOBAL'] = 0 self.rqdExeInp['LNFM_FILE'] = '' - tile_file_type = self.rqdExeInp.get('TILE_FILE_TYPE', 'default') + tile_file_format = self.rqdExeInp.get('TILE_FILE_FORMAT', 'DEFAULT') if int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1 : txt_tile = glob.glob(self.bcs_geom + '*.til') - nc4_tile = glob.glob(self.bcs_geom + '*.nc4') - if tile_file_type.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] - if tile_file_type.upper() == 'NC4' : self.rqdExeInp['TILING_FILE'] = nc4_tile[0] - if tile_file_type.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[-1] + nc4_tile = glob.glob(self.bcs_geom + '*.nc4') + if tile_file_format.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] + if tile_file_format.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[-1] self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] @@ -358,9 +357,8 @@ class LDASsetup: _numd = int(linecache.getline(ldas_domain, 1).strip()) txt_tile = glob.glob(self.bcs_geom + '*.til') nc4_tile = glob.glob(self.bcs_geom + '*.nc4') - if tile_file_type.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] - if tile_file_type.upper() == 'NC4' : self.rqdExeInp['TILING_FILE'] = nc4_tile[0] - if tile_file_type.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[-1] + if tile_file_format.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] + if tile_file_format.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[-1] self.rqdExeInp['GRN_FILE']= glob.glob(self.bcs_land + 'green_clim_*.data')[0] self.rqdExeInp['LAI_FILE']= glob.glob(self.bcs_land + 'lai_clim_*.data')[0] diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index eccefd96..7bf187d3 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -2753,9 +2753,9 @@ end subroutine convert_pert_rst ! ************************************************************************************************** - subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, r2g, N_catg, types ) + subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, r2g, N_tiles_land_g, types ) - ! read land tile information from *.til file + ! read tile information from *.til file ! ! This subroutine: ! - is the GEOSldas version of the LDASsa subroutine read_til_file() and @@ -2763,17 +2763,17 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! ! inputs: ! tile_file : *.til tile definition file (full path + name) - ! catch_file : catchment.def file (full path + name) + ! catch_file : catchment.def file (full path + name) ! ! outputs: ! tile_grid_g : parameters of tile definition grid - ! tile_coord_land : coordinates of tiles (see tile_coord_type), + ! tile_coord_r : coordinates of tiles (see tile_coord_type), ! implemented as pointer which is allocated in ! this subroutine - ! NOTE: number of *land* tiles can be diagnosed with size(tile_coord) + ! ! optional: - ! r2g : the restart domain id to the global id - ! N_catg : Number of land tiles + ! r2g : the restart domain id to the global id + ! N_tiles_land_g : Number of *land* tiles in global domain ! "tile_id" is no longer read from *.til file and is now set in this ! subroutine to match order of tiles in *.til file @@ -2783,6 +2783,9 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! and minor clean-up ! - reichle, 2 Aug 2020 ! + ! modified to accommodate additional tile types (landice) + ! - wjiang, reichle, 30 Apr 2025 + ! ! ------------------------------------------------------------- implicit none @@ -2791,7 +2794,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, character(*), intent(in) :: catch_file type(grid_def_type), intent(inout):: tile_grid_g type(tile_coord_type), dimension(:), pointer :: tile_coord_r ! out - integer, intent(out) :: N_catg + integer, intent(out) :: N_tiles_land_g integer, dimension(:), pointer :: r2g ! out integer, dimension(:), optional :: types ! input @@ -2802,7 +2805,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, real :: ease_cell_area integer :: i, n_tiles, n_grids,tmpint1, tmpint2, tmpint3, tmpint4 integer :: i_indg_offset, j_indg_offset, col_order - integer :: n_tiles_land, n_lon, n_lat + integer :: n_lon, n_lat logical :: ease_grid, isNC4 integer :: typ, k, file_type, status integer, dimension(:), allocatable :: tile_types @@ -2826,7 +2829,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, if (present(types)) then tile_types = types else - tile_types =[MAPL_LAND] + tile_types =[MAPL_LAND] ! default is to include only land tiles endif ! read *.til file header @@ -2892,7 +2895,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, if (isNC4 ) then - N_catg = count(iTable(:,0) == MAPL_LAND .or. iTable(:,0) == (MAPL_LAND + MAPL_ExcludeFromDomain)) + N_tiles_land_g = count(iTable(:,0) == MAPL_LAND .or. iTable(:,0) == (MAPL_LAND + MAPL_ExcludeFromDomain)) tile_coord_r(:)%typ = iTable(r2g, 0) tile_coord_r(:)%i_indg = iTable(r2g, 2) tile_coord_r(:)%j_indg = iTable(r2g, 3) @@ -2912,7 +2915,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, tile_coord_r(:)%max_lat = rTable(r2g, 9) tile_coord_r(:)%elev = rTable(r2g, 10) - tile_coord_r%frac_pfaf = nodata_generic + tile_coord_r%frac_pfaf = nodata_generic tile_coord_r%pert_i_indg = nint(nodata_generic) tile_coord_r%pert_j_indg = nint(nodata_generic) else @@ -2923,15 +2926,15 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! WJ notes: i and k are the same---global ids ! fid --- num in simulation domain - N_catg = 0 + N_tiles_land_g = 0 do k=1,n_tiles read(10,'(A)') tmpline read(tmpline,*) typ - if (typ == MAPL_LAND .or. typ == MAPL_LAND + MAPL_ExcludeFromDomain) N_catg = N_catg + 1 + if (typ == MAPL_LAND .or. typ == MAPL_LAND + MAPL_ExcludeFromDomain) N_tiles_land_g = N_tiles_land_g + 1 - ! tile type "MAPL_Land_ExcludeFromDomain" identifies land tiles to exclude + ! tile type "MAPL_ExcludeFromDomain" identifies tiles to exclude ! when non-global domain is created if (any( tile_types == typ)) then ! all needed tiles @@ -3042,12 +3045,15 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing tile_coord_r%pert_i_indg = nint(nodata_generic) tile_coord_r%pert_j_indg = nint(nodata_generic) - tile_coord_r%elev = nodata_generic - call read_catchment_def( catch_file, N_catg, tile_coord_r ) + tile_coord_r%elev = nodata_generic + call read_catchment_def( catch_file, N_tiles_land_g, tile_coord_r ) ! ---------------------------------------------------------------------- ! ! if elevation info is still needed, read *gridded* elevation data (check only first tile!) + + ! at this stage, elev should still be needed only for very old bcs that were created before + ! elev was included in catchment.def (wjiang+reichle, 30 Apr 2025) ! gridded elevation file is NOT available for EASE grids, where elevation information ! is in catchment.def file From 347642e690dd43e0f73bf3acbe50af91dfc7a097 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 30 Apr 2025 14:39:24 -0400 Subject: [PATCH 39/55] minimal edits to comments and white space (preprocess_ldas_routines.F90) --- GEOSldas_App/preprocess_ldas_routines.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 7bf187d3..aba896d3 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -3036,10 +3036,16 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, end do close(10) - ! i here is the number of restart nmuber including types in 'types') + + ! i here is the number of tiles including all types specified in 'types' + n_tiles = i - allocate(r2g, source= r2g_tmp(1:n_tiles)) + + ! allocate and fill output variables (r2g, tile_coord_r) + + allocate(r2g, source = r2g_tmp( 1:n_tiles)) allocate(tile_coord_r, source = tile_coord(1:n_tiles)) + deallocate(tile_coord) deallocate(r2g_tmp) ! pert_[x]_indg is not written into the tile_coord file and not needed in preprocessing From a2d55fcf333c5b04d10e6d792859bbac8dbfb6cb Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 2 May 2025 10:19:45 -0400 Subject: [PATCH 40/55] fix bugs when there is only landice tile --- GEOSldas_App/ldas_setup | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 923ee879..8eb03a01 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -879,7 +879,7 @@ class LDASsetup: self.has_landassim_seed = True mk_outdir = self.exphome+'/'+exp_id+'/mk_restarts/' - if (RESTART_str != '1' and self.with_land): + if (RESTART_str != '1' and (self.with_land or self.with_landice)): bcs_path = self.rqdExeInp['BCS_PATH'] while bcs_path[-1] == '/' : bcs_path = bcs_path[0:-1] bc_base = os.path.dirname(bcs_path) @@ -894,7 +894,8 @@ class LDASsetup: config['input']['surface']['catch_tilefile'] = self.in_tilefile config['input']['shared']['expid'] = self.rqdExeInp['RESTART_ID'] config['input']['shared']['yyyymmddhh'] = YYYYMMDDHH - config['input']['shared']['rst_dir'] = os.path.dirname(self.in_rstfile)+'/' + if RESTART_str != 'M': + config['input']['shared']['rst_dir'] = os.path.dirname(self.in_rstfile)+'/' config['input']['surface']['wemin'] = wemin_in config['input']['surface']['catch_model'] = self.catch @@ -936,9 +937,10 @@ class LDASsetup: config['input']['shared']['MERRA-2'] = True config['input']['surface']['catch_tilefile'] = '/discover/nobackup/projects/gmao/bcs_shared/fvInput/ExtData/esm/tiles/GM4/geometry/CF0180x6C_DE1440xPE0720/CF0180x6C_DE1440xPE0720-Pfafstetter.til' - catch_obj = catchANDcn(config_obj = config) - catch_obj.remap() - if (self.with_landice): + if self.with_land: + catch_obj = catchANDcn(config_obj = config) + catch_obj.remap() + if self.with_landice: config['output']['surface']['remap_water'] = True config['input']['surface']['zoom'] = '2' landice_obj = lake_landice_saltwater(config_obj = config) @@ -972,9 +974,10 @@ class LDASsetup: if not os.path.isfile(vegdynRstFile): # no vegdyn restart from LDASsa if not os.path.isfile(vegdynRstFile0): vegdynRstFile = glob.glob(self.bcs_land + 'vegdyn_*.dat')[0] - else : + else: vegdynRstFile = glob.glob(self.bcs_land + 'vegdyn_*.dat')[0] - catchRstFile = glob.glob(self.exphome+'/'+exp_id+'/mk_restarts/*'+self.catch+'_internal_rst.'+YYYYMMDD+'*')[0] + if self.with_land: + catchRstFile = glob.glob(self.exphome+'/'+exp_id+'/mk_restarts/*'+self.catch+'_internal_rst.'+YYYYMMDD+'*')[0] # catchment restart file if os.path.isfile(catchRstFile) and self.with_land : From 8b7094782e41ed00d979cd88ec59c8efdd2b6c62 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 8 May 2025 14:53:51 -0400 Subject: [PATCH 41/55] added comments, white-space changes (LDAS_Convert.F90) --- LDAS_Shared/LDAS_Convert.F90 | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/LDAS_Shared/LDAS_Convert.F90 b/LDAS_Shared/LDAS_Convert.F90 index 5d1ae454..0993e13f 100644 --- a/LDAS_Shared/LDAS_Convert.F90 +++ b/LDAS_Shared/LDAS_Convert.F90 @@ -22,9 +22,9 @@ module LDAS_ConvertMod subroutine esmf2ldas_time(esmf_dt, ldas_dt, rc) - type(ESMF_Time), intent(in) :: esmf_dt + type(ESMF_Time), intent(in) :: esmf_dt type(date_time_type), intent(out) :: ldas_dt - integer, optional, intent(out) :: rc + integer, optional, intent(out) :: rc character(len=*), parameter :: Iam = 'emsf2ldas_time' integer :: status @@ -47,15 +47,24 @@ subroutine esmf2ldas_time(esmf_dt, ldas_dt, rc) end subroutine esmf2ldas_time - ! delimiter "," + ! -------------------------------------------- + subroutine string2tile_types( string, tile_types) + + ! break string with list of (comma-separated) tile types into vector of strings + character(len=ESMF_MAXSTR), intent(in) :: string character(10), allocatable, intent(out) :: tile_types(:) + character(10) :: outs4(4) - integer :: ntype , j, j0 - j = index(string, ',') + integer :: ntype , j, j0 + + j = index(string, ',') ! identify positions of commas (delimiter) ntype = 1 j0 = 0 + + ! loop through positions of commas + do while (.true.) if (j == 0) then outs4(ntype) = trim(adjustl(string(j0+1:))) @@ -67,7 +76,15 @@ subroutine string2tile_types( string, tile_types) j = index(string(j0+1:), ',') ntype = ntype+1 enddo + + ! assemble output vector of strings + allocate(tile_types(ntype), source=outs4(1:ntype)) + end subroutine string2tile_types + ! -------------------------------------------- + end module LDAS_ConvertMod + +! ========= EOF =========================================================== From fc99bc255ae5c530a5871136c53e749a086c166b Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 8 May 2025 16:32:10 -0400 Subject: [PATCH 42/55] clarified new rc variables (TILE_TYPES, TILE_FILE_FORMAT) in GEOSldas_LDAS.rc --- GEOSldas_App/GEOSldas_LDAS.rc | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/GEOSldas_App/GEOSldas_LDAS.rc b/GEOSldas_App/GEOSldas_LDAS.rc index 15c1538c..f6045465 100644 --- a/GEOSldas_App/GEOSldas_LDAS.rc +++ b/GEOSldas_App/GEOSldas_LDAS.rc @@ -29,7 +29,7 @@ CATCHMENT_OFFLINE: 1 CATCHMENT_SPINUP: 0 -# ---- Choice of land surface model +# ---- Choice of land surface model (for LAND tiles) # # 1 : Catchment model (default) # 2 : CatchmentCN-CLM4.0 @@ -37,19 +37,24 @@ CATCHMENT_SPINUP: 0 LSM_CHOICE: 1 -# ---- Choice of tile types for the model -# There should not have space between types -# LAND,LANDICE +# ---- Choice of tile type(s) +# +# Comma-separated list of tile types to be included in simulation. +# Do not use space before/after comma. Examples: +# +# LAND : include only land tiles +# LAND,LANDICE : include land and landice tiles +# LANDICE : include only landice tiles # TILE_TYPES: LAND -# ---- Choice of tile file format (from bcs directory) +# ---- Format of tile file (from bcs directory) # -# DEFAULT : Use nc4 tile file if it exists, txt tile file otherwise -# TXT : Use txt tile file (e.g., for 0-diff testing) +# DEFAULT : Use nc4 tile file if it exists, txt tile file otherwise +# TXT : Use txt tile file (e.g., for 0-diff testing) # -TILE_FILE_FORMAT: default +TILE_FILE_FORMAT: DEFAULT # ---- Domain definition From 0eceba0ffe0931b22088c3e8801c0b1b7c6b6b81 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 8 May 2025 16:44:41 -0400 Subject: [PATCH 43/55] clarified comments, white-space changes (GEOS_LdasGridComp.F90) --- GEOS_LdasGridComp.F90 | 55 ++++++++++++++++++++++--------------------- 1 file changed, 28 insertions(+), 27 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 19b7d514..d6458b47 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -9,28 +9,28 @@ module GEOS_LdasGridCompMod use ESMF use MAPL_Mod - use GEOS_MetforceGridCompMod, only: MetforceSetServices => SetServices - use GEOS_LandGridCompMod, only: LandSetServices => SetServices - use GEOS_LandPertGridCompMod, only: LandPertSetServices => SetServices - use GEOS_EnsGridCompMod, only: EnsSetServices => SetServices + use GEOS_MetforceGridCompMod, only: MetforceSetServices => SetServices + use GEOS_LandGridCompMod, only: LandSetServices => SetServices + use GEOS_LandPertGridCompMod, only: LandPertSetServices => SetServices + use GEOS_EnsGridCompMod, only: EnsSetServices => SetServices use GEOS_LandAssimGridCompMod, only: LandAssimSetServices => SetServices - use GEOS_LandiceGridCompMod, only : LandiceSetServices => SetServices + use GEOS_LandiceGridCompMod, only: LandiceSetServices => SetServices - use EASE_conv, only: ease_inverse - use LDAS_TileCoordType, only: tile_coord_type , T_TILECOORD_STATE, TILECOORD_WRAP - use LDAS_TileCoordType, only: grid_def_type, io_grid_def_type, operator (==) + use EASE_conv, only: ease_inverse + use LDAS_TileCoordType, only: tile_coord_type , T_TILECOORD_STATE, TILECOORD_WRAP + use LDAS_TileCoordType, only: grid_def_type, io_grid_def_type, operator (==) use LDAS_TileCoordRoutines, only: get_minExtent_grid, get_ij_ind_from_latlon, io_domain_files - use LDAS_ConvertMod, only: esmf2ldas, string2tile_types - use LDAS_PertRoutinesMod, only: get_pert_grid - use LDAS_ensdrv_functions,ONLY: get_io_filename - use LDAS_DateTimeMod,ONLY: date_time_type - use LDAS_ensdrv_mpi, only: MPI_tile_coord_type, MPI_grid_def_type - use LDAS_ensdrv_mpi, only: init_MPI_types,mpicomm,numprocs,myid - use LDAS_ensdrv_mpi, only: root_proc - use LDAS_ensdrv_Globals, only: logunit,logit,root_logit,echo_clsm_ensdrv_glob_param, get_ensid_string - use catch_constants, only: echo_catch_constants - use StieglitzSnow, only: StieglitzSnow_echo_constants - use SurfParams, only: SurfParams_init + use LDAS_ConvertMod, only: esmf2ldas, string2tile_types + use LDAS_PertRoutinesMod, only: get_pert_grid + use LDAS_ensdrv_functions, only: get_io_filename + use LDAS_DateTimeMod, only: date_time_type + use LDAS_ensdrv_mpi, only: MPI_tile_coord_type, MPI_grid_def_type + use LDAS_ensdrv_mpi, only: init_MPI_types,mpicomm,numprocs,myid + use LDAS_ensdrv_mpi, only: root_proc + use LDAS_ensdrv_Globals, only: logunit,logit,root_logit,echo_clsm_ensdrv_glob_param, get_ensid_string + use catch_constants, only: echo_catch_constants + use StieglitzSnow, only: StieglitzSnow_echo_constants + use SurfParams, only: SurfParams_init implicit none @@ -61,8 +61,9 @@ module GEOS_LdasGridCompMod logical :: land_assim logical :: mwRTM logical :: ensemble_forcing ! switch between deterministic and ensemble forcing - logical :: with_landice - logical :: with_land + logical :: with_landice ! true if landice tiles requested by config + logical :: with_land ! true if land tiles requested by config + contains !BOP @@ -175,14 +176,14 @@ subroutine SetServices(gc, rc) land_assim = (trim(LAND_ASSIM_STR) /= 'NO') if (land_assim .and. .not. with_land) then - _ASSERT( .false., "No land for land assimilation") + _ASSERT( .false., "Inconsistent configuration: Land assimilation requested but no land tiles requested.") endif call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) mwRTM = ( len_trim(mwRTM_file) /= 0 ) if (mwRTM .and. .not. with_land) then - print*, "No land for assimilation, no mwRTM file is necessary" + print*, "Warning: Requested mwRTM file is not necessary because no land tiles requested." mwRTM = .false. endif @@ -197,7 +198,7 @@ subroutine SetServices(gc, rc) allocate(METFORCE(1)) endif - if (with_land) allocate(LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) + if (with_land) allocate(LAND( NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) if (with_landice) allocate(LANDICE(NUM_ENSEMBLE)) ! ens_id_with = 2 + number of digits = total number of chars in ensid_string ("_eXXXX") @@ -951,7 +952,7 @@ subroutine Run(gc, import, export, clock, rc) if (.not. ensemble_forcing) exit enddo - ! distribute force. ( export of focrce to the import of land, landpert and landice) + ! distribute surface met forcing (export forcing to imports of land, landpert, and landice) do i = 1, NUM_ENSEMBLE k = 1 if (ensemble_forcing) k = i @@ -959,9 +960,9 @@ subroutine Run(gc, import, export, clock, rc) call MAPL_TimerOn(MAPL, gcnames(igc)) if (with_land) then - call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LAND(i)), clock=clock, phase=2, userRC=status) + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LAND(i)), clock=clock, phase=2, userRC=status) VERIFY_(status) - call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDPERT(i)), clock=clock, phase=3, userRC=status) + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDPERT(i)), clock=clock, phase=3, userRC=status) VERIFY_(status) endif From ec9aede913a9d9877e0df2a8975b158b7c1b221a Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 8 May 2025 16:49:08 -0400 Subject: [PATCH 44/55] minimal edit in "description" of glc collection (GEOSldas_HIST.rc) --- GEOSldas_App/GEOSldas_HIST.rc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSldas_App/GEOSldas_HIST.rc b/GEOSldas_App/GEOSldas_HIST.rc index a484888e..d9d09dd8 100644 --- a/GEOSldas_App/GEOSldas_HIST.rc +++ b/GEOSldas_App/GEOSldas_HIST.rc @@ -589,7 +589,7 @@ COLLECTIONS: 'WESNPREC' , 'LANDICE' , :: - tavg24_1d_glc_Nt.descr: 'Tile-space, Daily, Time-Averaged, Single-level,Land Ice Outputs', + tavg24_1d_glc_Nt.descr: 'Tile-space,Daily,Time-Averaged,Single-level,Land Ice Diagnostics', tavg24_1d_glc_Nt.nbits: 12, tavg24_1d_glc_Nt.template: '%y4%m2%d2_%h2%n2z.bin' , tavg24_1d_glc_Nt.mode: 'time-averaged' , From 13b402da1db61a4d9ed5e7d49439bedb5130fafc Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 8 May 2025 16:53:59 -0400 Subject: [PATCH 45/55] fixed white space (tile_bin2nc4.F90) --- GEOSldas_App/tile_bin2nc4.F90 | 72 +++++++++++++++++------------------ 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/GEOSldas_App/tile_bin2nc4.F90 b/GEOSldas_App/tile_bin2nc4.F90 index 72d05799..890bfd82 100644 --- a/GEOSldas_App/tile_bin2nc4.F90 +++ b/GEOSldas_App/tile_bin2nc4.F90 @@ -470,10 +470,10 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) ! land ice fields case ('EMIS'); LONG_NAME = 'surface_emissivity'; UNITS = '1' - case ('ALBVR_GL'); LONG_NAME = 'surface_reflectivity_for_visible_beam'; UNITS = '1' - case ('ALBVF_GL'); LONG_NAME = 'surface_reflectivity_for_visible_diffuse'; UNITS = '1' - case ('ALBNR_GL'); LONG_NAME = 'surface_reflectivity_for_near_infrared_beam'; UNITS = '1' - case ('ALBNF_GL'); LONG_NAME = 'surface_reflectivity_for_near_infrared_direct'; UNITS = '1' + case ('ALBVR_GL'); LONG_NAME = 'surface_reflectivity_for_visible_beam'; UNITS = '1' + case ('ALBVF_GL'); LONG_NAME = 'surface_reflectivity_for_visible_diffuse'; UNITS = '1' + case ('ALBNR_GL'); LONG_NAME = 'surface_reflectivity_for_near_infrared_beam'; UNITS = '1' + case ('ALBNF_GL'); LONG_NAME = 'surface_reflectivity_for_near_infrared_direct'; UNITS = '1' case ('TST'); LONG_NAME = 'surface_temperature'; UNITS = 'K' case ('QST'); LONG_NAME = 'surface_specific_humidity'; UNITS = 'kg kg-1' case ('TH'); LONG_NAME = 'turbulence_surface_skin_temperature'; UNITS = 'K' @@ -508,38 +508,38 @@ FUNCTION getAttribute (SHORT_NAME, LNAME, UNT) result (str_atr) case ('WESNDENS'); LONG_NAME = 'snow_layer_mass_change_due_to_densification'; UNITS = 'kg m-2 s-1' case ('WESNREPAR'); LONG_NAME = 'snow_layer_mass_change_due_to_repartition'; UNITS = 'kg m-2 s-1' case ('WESNBOT'); LONG_NAME = 'frozen_runoff_due_to_fixed_max_depth'; UNITS = 'kg m-2 s-1' - case ('RAINRFZ'); LONG_NAME = 'contribution_to_surface_mass_balance_from_rain_frozen_onto_bare_ice'; UNITS = 'kg m-2 s-1' - case ('SMELT'); LONG_NAME = 'snow_melt_flux'; UNITS = 'kg_m-2 s-1' - case ('IMELT'); LONG_NAME = 'ice_melt_flux'; UNITS = 'kg_m-2 s-1' - case ('SNOWALB'); LONG_NAME = 'snow_broadband_reflectivity'; UNITS = '1' - case ('SNICEALB'); LONG_NAME = 'aggregated_snow_ice_broadband_reflectivity'; UNITS = '1' - case ('MELTWTR'); LONG_NAME = 'melt_water_production'; UNITS = 'kg m-2 s-1' - case ('MELTWTRCONT'); LONG_NAME = 'snowpack_meltwater_content'; UNITS = 'kg m-2' - case ('LWC'); LONG_NAME = 'liquid_water_content_in_top_snow_layer'; UNITS = '1' - case ('RUNOFF_GL'); LONG_NAME = 'runoff_total_flux'; UNITS = 'kg m-2 s-1' - case ('GUST'); LONG_NAME = 'gustiness'; UNITS = 'm s-1' - case ('VENT'); LONG_NAME = 'surface_ventilation_velocity'; UNITS = 'm s-1' - case ('Z0'); LONG_NAME = 'surface_roughness'; UNITS = 'm' - case ('Z0H'); LONG_NAME = 'surface_roughness_for_heat'; UNITS = 'm' - case ('MOT2M'); LONG_NAME = 'temperature_2m_wind_from_MO_sfc'; UNITS = 'K' - case ('MOQ2M'); LONG_NAME = 'humidity_2m_wind_from_MO_sfc'; UNITS = 'kg kg-1' - case ('MOU2M'); LONG_NAME = 'zonal_2m_wind_from_MO_sfc'; UNITS = 'm s-1' - case ('MOV2M'); LONG_NAME = 'meridional_2m_wind_from_MO_sfc'; UNITS = 'm s-1' - case ('MOT10M'); LONG_NAME = 'temperature_10m_wind_from_MO_sfc'; UNITS = 'K' - case ('MOQ10M'); LONG_NAME = 'humidity_10m_wind_from_MO_sfc'; UNITS = 'kg kg-1' - case ('MOU10M'); LONG_NAME = 'zonal_10m_wind_from_MO_sfc'; UNITS = 'm s-1' - case ('MOV10M'); LONG_NAME = 'meridional_10m_wind_from_MO_sfc'; UNITS = 'm s-1' - case ('MOU50M'); LONG_NAME = 'zonal_50m_wind_from_MO_sfc'; UNITS = 'm s-1' - case ('MOV50M'); LONG_NAME = 'merodopma;_50m_wind_from_MO_sfc'; UNITS = 'm s-1' - case ('EVAPOUT'); LONG_NAME = 'evaporation'; UNITS = 'kg m-2 s-1' - case ('SHOUT'); LONG_NAME = 'upward_sensible_heat_flux'; UNITS = 'W m-2' - case ('HLWUP_GL'); LONG_NAME = 'surface_emitted_longwave_flux'; UNITS = 'W m-2' - case ('LWNDSRF'); LONG_NAME = 'surface_net_downward_longwave_flux'; UNITS = 'W m-2' - case ('SWNDSRF'); LONG_NAME = 'surface_net_downward_shortwave_flux'; UNITS = 'W m-2' - case ('HLATN'); LONG_NAME = 'total_latent_energy_flux'; UNITS = 'W m-2' - case ('DNICFLX'); LONG_NAME = 'downward_heat_flux_in_ice'; UNITS = 'W m-2' - case ('GHSNOW'); LONG_NAME = 'ground_heating_snow'; UNITS = 'W m-2' - case ('GHTSKIN_GL'); LONG_NAME = 'glacier_ice_heating_flux'; UNITS = 'W m-2' + case ('RAINRFZ'); LONG_NAME = 'contribution_to_surface_mass_balance_from_rain_frozen_onto_bare_ice'; UNITS = 'kg m-2 s-1' + case ('SMELT'); LONG_NAME = 'snow_melt_flux'; UNITS = 'kg_m-2 s-1' + case ('IMELT'); LONG_NAME = 'ice_melt_flux'; UNITS = 'kg_m-2 s-1' + case ('SNOWALB'); LONG_NAME = 'snow_broadband_reflectivity'; UNITS = '1' + case ('SNICEALB'); LONG_NAME = 'aggregated_snow_ice_broadband_reflectivity'; UNITS = '1' + case ('MELTWTR'); LONG_NAME = 'melt_water_production'; UNITS = 'kg m-2 s-1' + case ('MELTWTRCONT'); LONG_NAME = 'snowpack_meltwater_content'; UNITS = 'kg m-2' + case ('LWC'); LONG_NAME = 'liquid_water_content_in_top_snow_layer'; UNITS = '1' + case ('RUNOFF_GL'); LONG_NAME = 'runoff_total_flux'; UNITS = 'kg m-2 s-1' + case ('GUST'); LONG_NAME = 'gustiness'; UNITS = 'm s-1' + case ('VENT'); LONG_NAME = 'surface_ventilation_velocity'; UNITS = 'm s-1' + case ('Z0'); LONG_NAME = 'surface_roughness'; UNITS = 'm' + case ('Z0H'); LONG_NAME = 'surface_roughness_for_heat'; UNITS = 'm' + case ('MOT2M'); LONG_NAME = 'temperature_2m_wind_from_MO_sfc'; UNITS = 'K' + case ('MOQ2M'); LONG_NAME = 'humidity_2m_wind_from_MO_sfc'; UNITS = 'kg kg-1' + case ('MOU2M'); LONG_NAME = 'zonal_2m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOV2M'); LONG_NAME = 'meridional_2m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOT10M'); LONG_NAME = 'temperature_10m_wind_from_MO_sfc'; UNITS = 'K' + case ('MOQ10M'); LONG_NAME = 'humidity_10m_wind_from_MO_sfc'; UNITS = 'kg kg-1' + case ('MOU10M'); LONG_NAME = 'zonal_10m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOV10M'); LONG_NAME = 'meridional_10m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOU50M'); LONG_NAME = 'zonal_50m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('MOV50M'); LONG_NAME = 'merodopma;_50m_wind_from_MO_sfc'; UNITS = 'm s-1' + case ('EVAPOUT'); LONG_NAME = 'evaporation'; UNITS = 'kg m-2 s-1' + case ('SHOUT'); LONG_NAME = 'upward_sensible_heat_flux'; UNITS = 'W m-2' + case ('HLWUP_GL'); LONG_NAME = 'surface_emitted_longwave_flux'; UNITS = 'W m-2' + case ('LWNDSRF'); LONG_NAME = 'surface_net_downward_longwave_flux'; UNITS = 'W m-2' + case ('SWNDSRF'); LONG_NAME = 'surface_net_downward_shortwave_flux'; UNITS = 'W m-2' + case ('HLATN'); LONG_NAME = 'total_latent_energy_flux'; UNITS = 'W m-2' + case ('DNICFLX'); LONG_NAME = 'downward_heat_flux_in_ice'; UNITS = 'W m-2' + case ('GHSNOW'); LONG_NAME = 'ground_heating_snow'; UNITS = 'W m-2' + case ('GHTSKIN_GL'); LONG_NAME = 'glacier_ice_heating_flux'; UNITS = 'W m-2' ! default LONG_NAME and UNITS for nc4 files created by tile_bin2nc4.F90 (used for any SHORT_NAME not listed above): From 701502bb22d9c7a6cb4a1fa47653c9c9e3954f42 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 8 May 2025 16:57:25 -0400 Subject: [PATCH 46/55] added comment (LDAS_RepairForcing.F90) --- LDAS_Shared/LDAS_RepairForcing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LDAS_Shared/LDAS_RepairForcing.F90 b/LDAS_Shared/LDAS_RepairForcing.F90 index 52789b40..be06594c 100644 --- a/LDAS_Shared/LDAS_RepairForcing.F90 +++ b/LDAS_Shared/LDAS_RepairForcing.F90 @@ -57,7 +57,7 @@ subroutine repair_forcing( N_catd, met_force, echo, tile_coord, fieldname, & ! min/max values for allowable range of forcing fields - real, parameter :: min_Tair = 180. ! [K] + real, parameter :: min_Tair = 180. ! [K] ! changed from 190 K to 180 K to accommodate landice, lcandre2, May 2025 real, parameter :: max_Tair = 340. ! [K] real, parameter :: max_PSurf = 115000. ! [Pa] From 90b5f24c541033ea910dba230054d2a2c0233cfe Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 8 May 2025 17:17:32 -0400 Subject: [PATCH 47/55] edited error messages (ldas_setup) --- GEOSldas_App/ldas_setup | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 8eb03a01..c482bb22 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -20,7 +20,7 @@ from datetime import timedelta from collections import OrderedDict from dateutil.relativedelta import relativedelta from remap_utils import * -from remap_catchANDcn import * +from remap_catchANDcn import * from remap_lake_landice_saltwater import * from lenkf_j_template import * """ @@ -125,8 +125,8 @@ class LDASsetup: self.bcs_land = '' self.bcs_geom = '' self.bcs_landshared = '' - self.tile_types ='' - self.with_land = False + self.tile_types = '' + self.with_land = False self.with_landice = False # ------ @@ -167,7 +167,7 @@ class LDASsetup: self.tile_types = [tile_types[x.strip().upper()] for x in self.rqdExeInp.get('TILE_TYPES','LAND').split(',')] if "100" in self.tile_types : self.with_land = True - if "20" in self.tile_types : + if "20" in self.tile_types : self.with_landice = True # nens is an integer and =1 for model run @@ -356,7 +356,7 @@ class LDASsetup: if os.path.isfile(ldas_domain): _numd = int(linecache.getline(ldas_domain, 1).strip()) txt_tile = glob.glob(self.bcs_geom + '*.til') - nc4_tile = glob.glob(self.bcs_geom + '*.nc4') + nc4_tile = glob.glob(self.bcs_geom + '*.nc4') if tile_file_format.upper() == 'TXT' : self.rqdExeInp['TILING_FILE'] = txt_tile[0] if tile_file_format.upper() == 'DEFAULT' : self.rqdExeInp['TILING_FILE'] = (txt_tile+nc4_tile)[-1] @@ -790,7 +790,7 @@ class LDASsetup: if self.isZoomIn: newZoominTile = tile+'.domain' print ("\nCreating local tile file :"+ newZoominTile) - print ("\nExcluding tiles not in the domain by adding 1000 to the type ...\n") + print ("\nAdding 1000 to type of tiles to be excluded from domain...\n") cmd = self.bindir +'/preprocess_ldas.x zoomin_tile ' + tile + ' ' + newZoominTile + ' '+ tmp_f2g_file.name print ("cmd: " + cmd) sp.call(shlex.split(cmd)) @@ -1019,7 +1019,7 @@ class LDASsetup: if self.with_landice : if self.rqdExeInp['RESTART'].isdigit(): if int(self.rqdExeInp['RESTART']) == 0 or int(self.rqdExeInp['RESTART']) == 2 : - print(" landice type does not support REATART=0 or 2 option. please use M option(MERRA-2)") + print("RESTART=0 and RESTART=2 not supported for landice tiles. Please use RESTART=M (MERRA-2).") landiceRstFile = rstpath+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.'+'landice_internal_rst.'+y4m2d2_h2m2 else: landiceRstFile = glob.glob(self.exphome+'/'+exp_id+'/mk_restarts/*'+'landice_internal_rst.'+YYYYMMDD+'*')[0] @@ -1027,7 +1027,7 @@ class LDASsetup: if os.path.isfile(landiceRstFile) : landiceLocal = self.rstdir+ensdir +'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.landice_internal_rst.'+y4m2d2_h2m2 if self.isZoomIn : - print ("Creating coom in landice restart file... \n") + print ("Creating zoom-in of landice restart file... \n") cmd=self.bindir + '/preprocess_ldas.x zoomin_landicerst '+ landiceRstFile +' ' + landiceLocal + ' '+ tmp_f2g_file.name print ("cmd: " + cmd) sp.call(shlex.split(cmd)) @@ -1048,15 +1048,15 @@ class LDASsetup: pertRstFile = pertLocal if self.with_land : - print ('catchRstFile: ' + catchRstFile) + print ('catchRstFile: ' + catchRstFile) print ('vegdynRstFile: ' + vegdynRstFile) - os.symlink(catchRstFile, myCatchRst) + os.symlink(catchRstFile, myCatchRst) os.symlink(vegdynRstFile, myVegRst) if self.with_landice : print("link landice restart: " + myLandiceRst) - os.symlink(landiceRstFile, myLandiceRst) + os.symlink(landiceRstFile, myLandiceRst) if ( self.has_geos_pert and self.perturb == 1 ): - os.symlink(pertRstFile, myPertRst) + os.symlink(pertRstFile, myPertRst) # catch_param restar file catch_param_file = self.bcsdir+'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.ldas_catparam.'+y4m2d2_h2m2+'z.bin' From b1482ff988f2831084238d00464a26a288d038c1 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 8 May 2025 17:28:50 -0400 Subject: [PATCH 48/55] fixed typo in variable name, tweaked subroutine names, white-space changes (GEOS_MetforceGridComp.F90) --- .../GEOS_MetforceGridComp.F90 | 98 ++++++++++--------- 1 file changed, 53 insertions(+), 45 deletions(-) diff --git a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index 6e4e9cea..308735c7 100644 --- a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -74,9 +74,9 @@ module GEOS_MetforceGridCompMod integer, parameter :: k_aerosol = 18 integer, parameter :: k_landice = 15 character(len=7), dimension(k_force) :: export_name = ['Tair ', 'Qair ', 'Psurf ', & - 'Rainf_C', 'Snowf ', 'LWdown ', & - 'PARdrct', 'PARdffs', 'Wind ', & - 'RefH ', 'Rainf ', 'SWdown '] + 'Rainf_C', 'Snowf ', 'LWdown ', & + 'PARdrct', 'PARdffs', 'Wind ', & + 'RefH ', 'Rainf ', 'SWdown '] character(len=4), dimension(k_aerosol) :: aerosol_name = [ & 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & @@ -133,7 +133,7 @@ subroutine SetServices(gc, rc) ) VERIFY_(status) - ! phase 1 get force + ! phase 1 get forcing call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & @@ -145,7 +145,7 @@ subroutine SetServices(gc, rc) call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & - DistributeForcetoLand, & + DistributeForcingToLand, & rc=status & ) VERIFY_(status) @@ -154,7 +154,7 @@ subroutine SetServices(gc, rc) call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & - DistributeForcetoLandPert, & + DistributeForcingToLandPert, & rc=status & ) VERIFY_(status) @@ -163,7 +163,7 @@ subroutine SetServices(gc, rc) call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & - DistributeForcetoLandIce, & + DistributeForcingToLandIce, & rc=status & ) VERIFY_(status) @@ -605,7 +605,7 @@ subroutine Initialize(gc, import, export, clock, rc) type(tile_coord_type), pointer :: tile_coord(:)=>null() ! Misc variables - integer :: locat_nt, k, NUM_ENSEMBLE, i1, i2, j1, j2 + integer :: local_nt, k, NUM_ENSEMBLE, i1, i2, j1, j2 integer :: ForceDtStep type(met_force_type) :: mf_nodata logical :: MERRA_file_specs, ensemble_forcing @@ -653,7 +653,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) call MAPL_LocStreamGet( & locstream, & - NT_LOCAL=locat_nt, & + NT_LOCAL=local_nt, & TILELATS=TileLats, & TILELONS=TileLons, & TILETYPE=tiletype, & @@ -716,12 +716,12 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) ! -allocate-memory-for-metforcing-data- mf_nodata = nodata_generic - allocate(mf%DataPrv(locat_nt), source=mf_nodata, stat=status) + allocate(mf%DataPrv(local_nt), source=mf_nodata, stat=status) VERIFY_(status) - allocate(mf%DataNxt(locat_nt), source=mf_nodata, stat=status) + allocate(mf%DataNxt(local_nt), source=mf_nodata, stat=status) VERIFY_(status) ! -allocate-memory-for-avg-zenith-angle - allocate(mf%zenav(locat_nt), source=nodata_generic, stat=status) + allocate(mf%zenav(local_nt), source=nodata_generic, stat=status) VERIFY_(status) call MAPL_GetResource ( MAPL, ENS_FORCING_STR, Label="ENSEMBLE_FORCING:", DEFAULT="NO", RC=STATUS) VERIFY_(STATUS) @@ -763,7 +763,7 @@ subroutine Initialize(gc, import, export, clock, rc) ForceDtStep, & internal%mf%Path, & internal%mf%Tag, & - locat_nt, & + local_nt, & tile_coord, & internal%mf%hinterp, & AEROSOL_DEPOSITION, & @@ -840,7 +840,7 @@ subroutine Run(gc, import, export, clock, rc) type(tile_coord_type), pointer :: tile_coord(:) ! Misc variables - integer :: locat_nt ! number of tiles in local PE + integer :: local_nt ! number of tiles in local PE integer :: comm logical :: IAmRoot integer :: fdtstep @@ -928,9 +928,9 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_LocStreamGet( & locstream, & - NT_LOCAL=locat_nt, & - TILELATS=TileLats, & - TILELONS=TileLons, & + NT_LOCAL=local_nt, & + TILELATS=TileLats, & + TILELONS=TileLons, & rc=status & ) VERIFY_(status) @@ -939,11 +939,11 @@ subroutine Run(gc, import, export, clock, rc) call MAPL_Get(MAPL, orbit=orbit) ! Allocate memory for zenith angle - allocate(zth(locat_nt), source=nodata_generic, stat=status) + allocate(zth( local_nt), source=nodata_generic, stat=status) VERIFY_(status) - allocate(slr(locat_nt), source=nodata_generic, stat=status) + allocate(slr( local_nt), source=nodata_generic, stat=status) VERIFY_(status) - allocate(zth_tmp(locat_nt), source=nodata_generic, stat=status) + allocate(zth_tmp(local_nt), source=nodata_generic, stat=status) VERIFY_(status) ! Convert forcing time interval to seconds @@ -990,7 +990,7 @@ subroutine Run(gc, import, export, clock, rc) fdtstep, & internal%mf%Path, & internal%mf%Tag, & - locat_nt, & + local_nt, & tile_coord, & internal%mf%hinterp, & AEROSOL_DEPOSITION, & @@ -1025,7 +1025,7 @@ subroutine Run(gc, import, export, clock, rc) ! dayOfYear=DAY_OF_YEAR, RC=STATUS) ! VERIFY_(STATUS) - ! call zenith(DAY_OF_YEAR,SEC_OF_DAY,fdtstep,ModelTimeStep,locat_nt,tile_coord%com_lon, & + ! call zenith(DAY_OF_YEAR,SEC_OF_DAY,fdtstep,ModelTimeStep,local_nt,tile_coord%com_lon, & ! tile_coord%com_lat,internal%mf%zenav) @@ -1057,7 +1057,7 @@ subroutine Run(gc, import, export, clock, rc) !call ESMF_TimeGet(ModelTimeNxt, YY=YEAR, S=SEC_OF_DAY, & ! dayOfYear=DAY_OF_YEAR, RC=STATUS) !VERIFY_(STATUS) - !do n=1, locat_nt + !do n=1, local_nt ! call solar(tile_coord(n)%com_lon,tile_coord(n)%com_lat, DAY_OF_YEAR,SEC_OF_DAY,zth(n),slr(n)) !enddo @@ -1080,7 +1080,7 @@ subroutine Run(gc, import, export, clock, rc) ! Allocate memory for interpolated MetForcing data mf_nodata = nodata_generic - allocate(mfDataNtp(locat_nt), source=mf_nodata, stat=status) + allocate(mfDataNtp(local_nt), source=mf_nodata, stat=status) VERIFY_(status) ! Interpolate MetForcing data to the end of model integration time step @@ -1274,18 +1274,20 @@ subroutine Run(gc, import, export, clock, rc) end subroutine Run - subroutine DistributeForcetoLand(gc, export, land_import, clock, rc) - type(ESMF_GridComp), intent(inout) :: gc ! Gridded component - type(ESMF_State), intent(inout) :: export ! Export state + subroutine DistributeForcingToLand(gc, export, land_import, clock, rc) + + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_State), intent(inout) :: land_import ! Import state - type(ESMF_Clock), intent(inout) :: clock ! The clock - integer, optional, intent( out) :: rc ! Error code + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + real, pointer :: out1d(:), in1d(:) real, pointer :: out2d(:,:), in2d(:,:) integer :: k, AEROSOL_DEPOSITION, status type(MAPL_MetaComp), pointer :: MAPL character(len=ESMF_MAXSTR) :: Iam - Iam = "metForce::DistributeForcetoLand" + Iam = "metForce::DistributeForcingToLand" call MAPL_GetObjectFromGC(gc, MAPL, _RC) call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", DEFAULT=1, _RC) @@ -1304,19 +1306,21 @@ subroutine DistributeForcetoLand(gc, export, land_import, clock, rc) call MAPL_GetPointer(land_import, in1d, 'DZ', _RC) in1d = out1d(1:NUM_LAND_TILE) RETURN_(ESMF_SUCCESS) - end subroutine DistributeForcetoLand + + end subroutine DistributeForcingToLand - subroutine DistributeForcetoLandPert(gc, export, landpert_import, clock, rc) - type(ESMF_GridComp), intent(inout) :: gc ! Gridded component - type(ESMF_State), intent(inout) :: export ! Export state + subroutine DistributeForcingToLandPert(gc, export, landpert_import, clock, rc) + + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_State), intent(inout) :: landpert_import ! Import state - type(ESMF_Clock), intent(inout) :: clock ! The clock - integer, optional, intent( out) :: rc ! Error code + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code real, pointer :: out1d(:), in1d(:) integer :: k, status character(len=ESMF_MAXSTR) :: Iam - Iam = "metForce::DistributeForcetoLandPert" + Iam = "metForce::DistributeForcingToLandPert" do k = 1, k_force call MAPL_GetPointer(export, out1d, trim(export_name(k)), _RC) @@ -1324,21 +1328,24 @@ subroutine DistributeForcetoLandPert(gc, export, landpert_import, clock, rc) in1d = out1d(1:NUM_LAND_TILE) enddo RETURN_(ESMF_SUCCESS) - end subroutine DistributeForcetoLandPert + + end subroutine DistributeForcingToLandPert - subroutine DistributeForcetoLandIce(gc, export, landice_import, clock, rc) - type(ESMF_GridComp), intent(inout) :: gc ! Gridded component - type(ESMF_State), intent(inout) :: export ! Export state + subroutine DistributeForcingToLandIce(gc, export, landice_import, clock, rc) + + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_State), intent(inout) :: landice_import ! Import state - type(ESMF_Clock), intent(inout) :: clock ! The clock - integer, optional, intent( out) :: rc ! Error code + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + integer :: k, i1, i2, AEROSOL_DEPOSITION, status real, pointer :: out1d(:), in1d(:), tmp(:) real, pointer :: out2d(:,:), in2d(:,:) real, allocatable :: tmpreal(:) type(MAPL_MetaComp), pointer :: MAPL character(len=ESMF_MAXSTR) :: Iam - Iam = "metForce::DistributeForcetoLandice" + Iam = "metForce::DistributeForcingToLandice" if (NUM_LANDICE_TILE == 0) then RETURN_(ESMF_SUCCESS) @@ -1392,7 +1399,8 @@ subroutine DistributeForcetoLandIce(gc, export, landice_import, clock, rc) deallocate(tmpreal) RETURN_(ESMF_SUCCESS) - end subroutine DistributeForcetoLandIce + + end subroutine DistributeForcingToLandIce !BOP From 36108921ccf1ca881dc46cf9149d42798d28a3e2 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 9 May 2025 17:13:42 -0400 Subject: [PATCH 49/55] minimal white-space changes (preprocess_ldas.F90) --- GEOSldas_App/preprocess_ldas.F90 | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/GEOSldas_App/preprocess_ldas.F90 b/GEOSldas_App/preprocess_ldas.F90 index 332a945d..67e3e9ef 100644 --- a/GEOSldas_App/preprocess_ldas.F90 +++ b/GEOSldas_App/preprocess_ldas.F90 @@ -46,18 +46,19 @@ program main character(len=512) :: f2g_file character(len=12 ) :: ymdhm character(len=12 ) :: SURFLAY + character(len=:), allocatable :: new_r, orig_r - integer, allocatable :: int_types(:) + integer, allocatable :: int_types(:) - call get_command_argument(1,option) - call get_command_argument(2,arg1) - call get_command_argument(3,arg2) - call get_command_argument(4,arg3) - call get_command_argument(5,arg4) - call get_command_argument(6,arg5) - call get_command_argument(7,arg6) - call get_command_argument(8,arg7) - call get_command_argument(9,arg8) + call get_command_argument( 1,option) + call get_command_argument( 2,arg1) + call get_command_argument( 3,arg2) + call get_command_argument( 4,arg3) + call get_command_argument( 5,arg4) + call get_command_argument( 6,arg5) + call get_command_argument( 7,arg6) + call get_command_argument( 8,arg7) + call get_command_argument( 9,arg8) call get_command_argument(10,arg9) if( trim(option) == "c_f2g") then @@ -153,8 +154,10 @@ program main contains subroutine get_tile_types(str_types, int_types) - character(*), intent(in) :: str_types - integer, allocatable, intent(out) :: int_types(:) + + character(*), intent(in) :: str_types + integer, allocatable, intent(out) :: int_types(:) + integer :: n, Length, from, to, i n = 1 Length = len(str_types) From e5fad70c9a9fa2d95caa5b18d9a541296636adc6 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 9 May 2025 17:18:33 -0400 Subject: [PATCH 50/55] cleanup (preprocess_ldas_routines.F90) - edited comments and error messages for clarity - replaced "catchment" --> "tile" where appropriate for clarity - replaced "catchment_def_file" and "cat_def_file" with "catch_def_file" for consistency - renamed MAPL_ExcludeFromDomain to ExcludeFromDomain (it's not a MAPL constant) - removed unnecessary "implicit none" statements - white-space changes - changed variable names for clarity: - N_catg --> N_tiles_land_g - N_catr --> N_tiles_land_r - N_catf, N_catd --> N_tiles_land_f --- GEOSldas_App/preprocess_ldas_routines.F90 | 557 +++++++++++----------- 1 file changed, 283 insertions(+), 274 deletions(-) diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index aba896d3..97f22df8 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -20,11 +20,29 @@ module preprocess_ldas_routines ! - is_in_domain() [from LDAS_ensdrv_functions.F90] ! - word_count() [from LDAS_ensdrv_functions.F90] ! - open_land_param_file() [from LDAS_ensdrv_functions.F90] - - ! xxx_g or _global include all tiles in the types() - ! r2g ( restart to global) - ! f2r ( simualtion to restart) - ! f2g ( simulation to global), f2g = r2g(f2r) + ! + ! Domains: + ! + ! g = *g*lobal domain : list of tiles defined in tile file from boundary conditions + ! r = *r*estart domain : list of tiles included in restart file(s) + ! f = *f*ull simulation domain : list of tiles included in simulation domain + ! ("full" domain as opposed to a "local" subdomain assigned to a given processor) + ! + ! The simulation and restart domains can be subsets of the global domain ("zoom-in"), + ! as long as the simulation domain is a subset of the restart domain. + ! + ! Mapping between domains: + ! + ! r2g : restart domain to global domain + ! f2r : simulation domain to restart domain + ! f2g : simulation domain to global domain, f2g = r2g(f2r) + ! + ! Number of tiles: + ! + ! N_tiles_[g,r,f] : number of tiles included in [g,r,f] domain (across all tile types) + ! N_tiles_land_[g,r,f] : number of *land* tiles included in [g,r,f] domain + ! + ! ---------------------------------------------------------- use netcdf @@ -97,69 +115,70 @@ module preprocess_ldas_routines character(10), private :: tmpstring10 character(40), private :: tmpstring40 - ! Tile type for land that is to be excluded from the simulation domain. - ! (GEOSldas allows for non-global simulations and repeated "zooming" - ! of the domain while MAPL generally assumes a complete (global) tile - ! space. The MAP_ExcludeFromDomain is added to the origial tile type and makes it possible to work - ! with complete (global) tile files (ie, make use of MAPL functionality) - ! and also maintain GEOSldas functionality. + ! GEOSldas allows for non-global simulations and repeated "zooming" of + ! the domain, while MAPL generally assumes a complete (global) tile space. + ! By adding the integer ExcludeFromDomain to the original MAPL_* tile + ! type for all tiles that should be excluded from the simulation domain, we + ! can work with global tile files (i.e., use MAPL tools) and also maintain + ! the non-global domain unctionality of GEOSldas. - integer, parameter :: MAPL_ExcludeFromDomain = 1000 ! added to original tile type to be excluded + integer, parameter :: ExcludeFromDomain = 1000 ! for tiles to be excluded from the simulation domain, this number is added to tile type contains ! ******************************************************************** - subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ymdhm, SURFLAY, mapping_file, types) - - implicit none - character(*) :: orig_tile - character(*) :: domain_def - character(*) :: out_path - character(*) :: catch_def_file - character(*) :: exp_id - character(*) :: ymdhm - character(*) :: SURFLAY - character(*) :: mapping_file - integer, dimension(:), optional, intent(in) :: types + subroutine create_mapping( orig_tile, domain_def, out_path, catch_def_file, exp_id, ymdhm, SURFLAY, mapping_file, types) - - real :: minlon,maxlon,minlat,maxlat - character(len=512):: exclude_file,include_file - character(len=512):: bcs_path - logical :: file_exist - logical :: d_exist,c_exist + character(*), intent(in) :: orig_tile + character(*), intent(in) :: domain_def + character(*), intent(in) :: out_path + character(*), intent(in) :: catch_def_file + character(*), intent(in) :: exp_id + character(*), intent(in) :: ymdhm + character(*), intent(in) :: SURFLAY + character(*), intent(in) :: mapping_file - type(grid_def_type) :: tile_grid_g,tile_grid_f - type(tile_coord_type), dimension(:), pointer :: tile_coord_r => null() - type(tile_coord_type), dimension(:), pointer :: tile_coord_f => null() - integer, dimension(:), pointer :: f2r => null() - integer, dimension(:), pointer :: r2g => null() ! restart domain to global - integer :: N_catg, N_types, n, n1, N_catf - integer, allocatable, dimension(:) :: tile_types - integer, allocatable, dimension(:) :: N_tiles_r, N_tiles_f + integer, dimension(:), optional, intent(in) :: types + + ! ---------------------------------------------------- + + real :: minlon,maxlon,minlat,maxlat + character(len=512 ):: exclude_file,include_file + character(len=512 ):: bcs_path + logical :: file_exist + logical :: d_exist,c_exist + + type(grid_def_type) :: tile_grid_g,tile_grid_f + type(tile_coord_type), dimension(:), pointer :: tile_coord_r => null() + type(tile_coord_type), dimension(:), pointer :: tile_coord_f => null() + integer, dimension(:), pointer :: f2r => null() + integer, dimension(:), pointer :: r2g => null() ! restart domain to global + integer :: N_tiles_land_g, N_types, n, n1, N_tiles_land_f + integer, dimension(:), allocatable :: tile_types + integer, dimension(:), allocatable :: N_tiles_r, N_tiles_f type(cat_param_type), dimension(:), allocatable :: cp - real :: dzsf + real :: dzsf - namelist / domain_inputs / & + namelist / domain_inputs / & minlon, maxlon,minlat,maxlat, & exclude_file,include_file inquire(file=trim(orig_tile),exist=file_exist) - if( .not. file_exist) stop ("original tile file not exist") + if( .not. file_exist) stop("original tile file does not exist") inquire(file=trim(domain_def),exist=d_exist) if( .not. d_exist) then - print*,"no domain definition file" + print*, "domain definition file does not exist", trim(domain_def) endif inquire(file=trim(catch_def_file),exist=c_exist) if( .not. c_exist) then - print*,"no catchment definition file:" , catch_def_file + print*,"catchment [land tile supplemental] definition file does not exist:" , trim(catch_def_file) endif if (present(types)) then - ! reorder tile types so it matches the tile file + ! reorder tile types so it matches the tile file (first LAND then LAKE then LANDICE) allocate(tile_types(size(types))) n = 1 if (any(types == MAPL_LAND)) then @@ -177,7 +196,7 @@ subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ym tile_types = [MAPL_LAND] endif - call LDAS_read_til_file(orig_tile,catch_def_file, tile_grid_g, tile_coord_r, r2g, N_catg, tile_types) + call LDAS_read_til_file( orig_tile, catch_def_file, tile_grid_g, tile_coord_r, r2g, N_tiles_land_g, tile_types) ! include and exclude files are absolute if(d_exist) then @@ -186,33 +205,33 @@ subroutine create_mapping(orig_tile,domain_def,out_path,catch_def_file,exp_id,ym close(10) else minlon = -180. - maxlon = 180. - minlat = -90. - maxlat = 90. + maxlon = 180. + minlat = -90. + maxlat = 90. exclude_file = ' ' include_file = ' ' endif call domain_setup( & - tile_coord_r, & + tile_coord_r, & tile_grid_g, & ' ', exclude_file, ' ', include_file, & trim(out_path), 'exp_domain ', trim(exp_id), & minlon, minlat, maxlon, maxlat, & - f2r, tile_coord_f, & + f2r, tile_coord_f, & tile_grid_f) - N_catf = count(tile_coord_f(:)%typ == MAPL_LAND) + N_tiles_land_f = count(tile_coord_f(:)%typ == MAPL_LAND) - allocate(cp(N_catf)) + allocate(cp(N_tiles_land_f)) read(SURFLAY,*) dzsf print*, "SURFLAY: ", dzsf n1 = index(catch_def_file,'/clsm/') bcs_path(1:n1-1) = catch_def_file(1:n1-1) - call read_cat_param( N_catg, N_catf, tile_coord_f, dzsf, bcs_path(1:n1-1), bcs_path(1:n1-1),bcs_path(1:n1-1), & + call read_cat_param( N_tiles_land_g, N_tiles_land_f, tile_coord_f, dzsf, bcs_path(1:n1-1), bcs_path(1:n1-1),bcs_path(1:n1-1), & cp ) - call write_cat_param(cp,N_catf) + call write_cat_param(cp,N_tiles_land_f) N_types = size(tile_types) allocate(N_tiles_r(N_types), N_tiles_f(N_types)) @@ -248,8 +267,6 @@ logical function is_in_list(N_list, list, this_one) ! reichle, 2 May 2003 - implicit none - integer :: N_list, this_one integer, dimension(N_list) :: list @@ -274,34 +291,32 @@ end function is_in_list logical function is_in_domain( & this_cat_exclude, this_cat_include, this_cat_in_box ) - ! determine whether catchment is in domain + ! determine whether tile is in domain ! - ! The domain is set up using (if present) an "ExcludeList" of catchments - ! to be excluded, an "IncludeList" (if present) of catchments to be included, + ! The domain is set up using (if present) an "ExcludeList" of tiles + ! to be excluded, an "IncludeList" (if present) of tiles to be included, ! and the bounding box of a rectangular "zoomed" area (as specified ! in the "exeinp" file used in ldas_setup). ! ! order of precedence: - ! 1. exclude catchments on ExcludeList - ! 2. include catchments on IncludeList or catchments within rectangular domain - ! (i.e., catchments in ExcludeList are *always* excluded) + ! 1. exclude tiles on ExcludeList + ! 2. include tiles on IncludeList or tiles within rectangular domain + ! (i.e., tiles in ExcludeList are *always* excluded) ! ! reichle, 7 May 2003 ! reichle, 9 May 2005 - redesign (no more continents) ! ! ---------------------------------------------------------------- - implicit none - logical :: this_cat_include, this_cat_exclude, this_cat_in_box is_in_domain = .false. - ! if catchment is NOT in ExcludeList + ! if tile is NOT in ExcludeList if (.not. this_cat_exclude) then - ! if catchment is within bounding box OR in IncludeList + ! if tile is within bounding box OR in IncludeList if ((this_cat_in_box) .or. (this_cat_include)) then @@ -318,9 +333,7 @@ logical function is_cat_in_box( & this_minlon, this_minlat, this_maxlon, this_maxlat, & minlon, minlat, maxlon, maxlat ) - ! determine whether catchment is within bounding box - reichle, 7 May 2003 - - implicit none + ! determine whether tile is within bounding box - reichle, 7 May 2003 real :: this_minlon, this_minlat, this_maxlon, this_maxlat real :: minlon, minlat, maxlon, maxlat @@ -347,21 +360,21 @@ subroutine domain_setup( & f2r, tile_coord_f, tile_grid_f ) ! Set up modeling domain and determine index vectors mapping from the - ! domain to global catchment space. + ! domain to global tile space. ! Determine actual bounding box for domain. ! Also return tile_coord for domain and tile_grid_d for domain. ! ! ----------------------- ! - ! The domain is set up using (if present) an "ExcludeList" of catchments - ! to be excluded, an "IncludeList" (if present) of catchments to be included, + ! The domain is set up using (if present) an "ExcludeList" of tiles + ! to be excluded, an "IncludeList" (if present) of tiles to be included, ! and the bounding box of a rectangular "zoomed" area (as specified ! in the "exeinp" file used in ldas_setup). ! ! order of precedence: - ! 1. exclude catchments in ExcludeList - ! 2. include catchments in IncludeList or catchments within rectangular domain - ! (i.e., catchments in ExcludeList are *always* excluded) + ! 1. exclude tiles in ExcludeList + ! 2. include tiles in IncludeList or tiles within rectangular domain + ! (i.e., tiles in ExcludeList are *always* excluded) ! ! input: ! @@ -372,16 +385,12 @@ subroutine domain_setup( & ! latitude -90:90 ! ! output: - ! N_cat_domain = number of catchments in zoomed domain - ! (for which model integration is conducted) - ! d2g = index from domain to global tiles + ! f2r = index mapping from (full) simulation domain to restart domain ! tile_coord_d = tile_coord vector for domain ! tile_grid_d = def of smallest subgrid of global tile_grid_g that contains - ! all catchments (or tiles) in the domain (tile_grid_d%i_offg, + ! all tiles (or tiles) in the domain (tile_grid_d%i_offg, ! tile_grid_d%j_offg are offsets in indices between tile_grid_g ! and tile_grid_d) - ! N_catd_cont = number of catchments of (full) domain on each continent - ! ! ! - reichle, May 7, 2003 ! - reichle, Nov 7, 2003 - computation of bounding box of actual domain @@ -393,8 +402,6 @@ subroutine domain_setup( & ! ! ---------------------------------------------------------- - implicit none - type(tile_coord_type), dimension(:), pointer :: tile_coord_r ! input type(grid_def_type), intent(in) :: tile_grid_g @@ -408,9 +415,9 @@ subroutine domain_setup( & real, intent(in) :: minlon, minlat ! from nml inputs real, intent(in) :: maxlon, maxlat ! from nml inputs - integer, dimension(:), pointer :: f2r ! output + integer, dimension(:), pointer :: f2r ! output - type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! output + type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! output type(grid_def_type), intent(out) :: tile_grid_f @@ -464,13 +471,13 @@ subroutine domain_setup( & print*, "Creating domain..., reading IncludeList and ExludeList if present..." ! ------------------------------------------------------------ ! - ! load ExcludeList: catchments listed in this file will *always* be excluded + ! load ExcludeList: tiles listed in this file will *always* be excluded fname = trim(exclude_path) // '/' // trim(exclude_file) call read_exclude_or_includelist(fname, ExcludeList) - ! load IncludeList: catchments listed in this file will be included + ! load IncludeList: tiles listed in this file will be included ! (unless excluded via ExcludeList) fname = trim(include_path) // '/' // trim(include_file) @@ -478,7 +485,7 @@ subroutine domain_setup( & call read_exclude_or_includelist(fname, IncludeList) ! ----------------- ! - ! find and count catchments that are in the domain + ! find and count tiles that are in the domain c3_grid = .false. if(index(tile_grid_g%gridtype,"c3")/=0) c3_grid = .true. @@ -526,7 +533,7 @@ subroutine domain_setup( & n_tiles_f = indomain if (n_tiles_f .eq. 0) then - err_msg = 'No catchments found in domain' + err_msg = 'No tiles found in domain' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) else if (logit) then @@ -537,9 +544,9 @@ subroutine domain_setup( & ! ------------------------------------------------------------------- ! - ! assemble d2g, tile_coord, tile_grid_d + ! assemble f2r, tile_coord, tile_grid_d - allocate(f2r( n_tiles_f)) + allocate(f2r( n_tiles_f)) allocate(tile_coord_f(n_tiles_f)) f2r(1:n_tiles_f) = tmp_f2r(1:n_tiles_f) @@ -547,9 +554,9 @@ subroutine domain_setup( & ! finalize extent of actual domain: ! determine smallest subgrid of tile_grid_d that contains all - ! catchments/tiles in domain + ! tiles in domain - tile_grid_f = get_minExtent_grid( n_tiles_f, tile_coord_f%i_indg, tile_coord_f%j_indg, & + tile_grid_f = get_minExtent_grid( n_tiles_f, tile_coord_f%i_indg, tile_coord_f%j_indg, & tile_coord_f%min_lon, tile_coord_f%min_lat, tile_coord_f%max_lon, tile_coord_f%max_lat, & tile_grid_g) @@ -581,20 +588,18 @@ end subroutine domain_setup ! ************************************************************************* - subroutine read_exclude_or_includelist(fname, MyList) + subroutine read_exclude_or_includelist( fname, MyList) - ! read numbers/IDs of catchments in MyList (ExcludeList or IncludeList) + ! read numbers/IDs of tiles in MyList (ExcludeList or IncludeList) ! ! format of MyList file: ASCII list of tile IDs ! - ! N_list = number of catchments in MyList + ! N_list = number of tiles in MyList ! ! reichle, 2 May 2003 ! ! -------------------------------------------------------------- - implicit none - character(*), intent(in) :: fname integer, dimension(:), allocatable, intent(out) :: MyList @@ -665,8 +670,6 @@ integer function word_count( mystring ) ! ! - reichle, 31 Mar 2015 - implicit none - character(len=*) :: mystring integer :: N_words, N_string, ii @@ -713,8 +716,6 @@ integer function open_land_param_file( unitnumber, formatted_file, is_big_endian ! ignore_stop = optional input, if present and .true., skip call to "stop_it()" - implicit none - integer :: unitnumber, N_search_dir logical :: formatted_file @@ -814,8 +815,8 @@ end function open_land_param_file ! ***************************************************************************************** - subroutine read_cat_param( & - N_catg, N_catf, tile_coord_f, dzsf, veg_path, soil_path, top_path, & + subroutine read_cat_param( & + N_tiles_land_g, N_tiles_land_f, tile_coord_f, dzsf, veg_path, soil_path, top_path, & cp ) ! Reads soil properties and topographic parameters from global files @@ -836,19 +837,17 @@ subroutine read_cat_param( & ! ! ------------------------------------------------------------------- - implicit none - - integer, intent(in) :: N_catg, N_catf + integer, intent(in) :: N_tiles_land_g, N_tiles_land_f - type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! intent(in) + type(tile_coord_type), dimension(:), pointer :: tile_coord_f ! intent(in) - real, intent(in) :: dzsf + real, intent(in) :: dzsf - character(*), intent(in) :: veg_path - character(*), intent(in) :: soil_path - character(*), intent(in) :: top_path + character(*), intent(in) :: veg_path + character(*), intent(in) :: soil_path + character(*), intent(in) :: top_path - type(cat_param_type), dimension(N_catf), intent(out) :: cp + type(cat_param_type), dimension(N_tiles_land_f), intent(out) :: cp ! local variables @@ -862,9 +861,9 @@ subroutine read_cat_param( & integer :: n, k, m, dummy_int, dummy_int2, istat, N_search_dir, N_col, gid - integer, dimension(N_catg) :: tmpint, tmpint2, tmptileid + integer, dimension(N_tiles_land_g) :: tmpint, tmpint2, tmptileid - real, dimension(N_catg,N_col_real_max) :: tmpreal + real, dimension(N_tiles_land_g,N_col_real_max) :: tmpreal real :: dummy_real, dummy_real2, z_in_m, term1, term2 @@ -927,7 +926,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'Using vegetation height look-up table' - do n=1,N_catg + do n=1,N_tiles_land_g read (10,*) tmptileid(n), dummy_int, tmpint(n) @@ -940,7 +939,7 @@ subroutine read_cat_param( & end if - do n=1,N_catg + do n=1,N_tiles_land_g tmpreal(n,1) = VGZ2( tmpint(n) ) @@ -953,7 +952,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'reading vegetation height from file' - do n=1,N_catg + do n=1,N_tiles_land_g ! 7-th column contains veg height in m ! 8-th column contains ASCAT z0 values (IGNORED for now, reichle, 31 Oct 2017) @@ -975,10 +974,10 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'done reading' if (logit) write (logunit,*) - do k=1,N_catf + do k=1,N_tiles_land_f ! this check works only for "SiB2_V2" and newer versions - gid = tile_coord_f(k)%tile_id + gid = tile_coord_f(k)%tile_id ! id of tile in *g*lobal tile file if (gid /=tmptileid(gid)) then err_msg = 'something wrong with veg parameters' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) @@ -1029,7 +1028,7 @@ subroutine read_cat_param( & tmpreal = nodata_generic - do n=1,N_catg + do n=1,N_tiles_land_g ! "SiB2_V2" version @@ -1043,7 +1042,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'done reading' if (logit) write (logunit,*) - do k=1,N_catf + do k=1,N_tiles_land_f gid = tile_coord_f(k)%tile_id if (tile_coord_f(k)%tile_id/=tmptileid(gid)) then err_msg = 'something wrong with soil parameters' @@ -1075,7 +1074,7 @@ subroutine read_cat_param( & ! "Icarus-NLv4" has 20 columns (new, last column is peat fraction, ignore for now) - do k=1,N_catf + do k=1,N_tiles_land_f gid = tile_coord_f(k)%tile_id cp(k)%gravel30 = tmpreal(gid, 7) cp(k)%orgC30 = tmpreal(gid, 8) @@ -1091,7 +1090,7 @@ subroutine read_cat_param( & case default - do k=1,N_catf + do k=1,N_tiles_land_f cp(k)%gravel30 = nodata_generic cp(k)%orgC30 = nodata_generic @@ -1122,7 +1121,7 @@ subroutine read_cat_param( & tmpreal = nodata_generic - do n=1,N_catg + do n=1,N_tiles_land_g read (10,*) tmptileid(n), dummy_int, (tmpreal(n,m), m=1,4) @@ -1133,7 +1132,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'done reading' if (logit) write (logunit,*) - do k=1,N_catf + do k=1,N_tiles_land_f ! this check works only for "SiB2_V2" version gid = tile_coord_f(k)%tile_id @@ -1190,7 +1189,7 @@ subroutine read_cat_param( & tmpreal = nodata_generic - do n=1,N_catg + do n=1,N_tiles_land_g read (10,*) tmptileid(n), dummy_int, (tmpreal(n,m), m=1,12) @@ -1201,7 +1200,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'done reading' if (logit) write (logunit,*) - do k=1,N_catf + do k=1,N_tiles_land_f ! this check works only for "SiB2_V2" version gid = tile_coord_f(k)%tile_id @@ -1238,7 +1237,7 @@ subroutine read_cat_param( & tmpreal = nodata_generic - do n=1,N_catg + do n=1,N_tiles_land_g read (10,*) tmptileid(n), dummy_int, (tmpreal(n,m), m=1,4) @@ -1249,7 +1248,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'done reading' if (logit) write (logunit,*) - do k=1,N_catf + do k=1,N_tiles_land_f ! this check works only for "SiB2_V2" version gid = tile_coord_f(k)%tile_id @@ -1283,7 +1282,7 @@ subroutine read_cat_param( & tmpreal = nodata_generic - do n=1,N_catg + do n=1,N_tiles_land_g read (10,*) tmptileid(n), dummy_int, (tmpreal(n,m), m=1,5) @@ -1293,7 +1292,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'done reading' if (logit) write (logunit,*) - do k=1,N_catf + do k=1,N_tiles_land_f ! this check works only for "SiB2_V2" version @@ -1321,7 +1320,7 @@ subroutine read_cat_param( & if (logit) write (logunit,*) 'computing derived land surface parameters...' if (logit) write (logunit,*) - do k=1,N_catf + do k=1,N_tiles_land_f ! Three soil depths for soil moisture model: ! @@ -1394,9 +1393,9 @@ end subroutine read_cat_param ! ********************************************************************************** - subroutine write_cat_param(cat_param, N_catd) + subroutine write_cat_param(cat_param, N_land_tiles_f) type(cat_param_type), intent(in) :: cat_param(:) - integer,intent(in) :: N_catd + integer,intent(in) :: N_land_tiles_f character(len=512):: fname type(date_time_type) :: start_time @@ -1418,65 +1417,65 @@ subroutine write_cat_param(cat_param, N_catd) print*, 'Writing catparam file : ' // trim(fname) - write (10) (cat_param(n)%dpth, n=1,N_catd) + write (10) (cat_param(n)%dpth, n=1,N_land_tiles_f) - write (10) (cat_param(n)%dzsf, n=1,N_catd) - write (10) (cat_param(n)%dzrz, n=1,N_catd) - write (10) (cat_param(n)%dzpr, n=1,N_catd) + write (10) (cat_param(n)%dzsf, n=1,N_land_tiles_f) + write (10) (cat_param(n)%dzrz, n=1,N_land_tiles_f) + write (10) (cat_param(n)%dzpr, n=1,N_land_tiles_f) do k=1,N_gt - write (10) (cat_param(n)%dzgt(k), n=1,N_catd) + write (10) (cat_param(n)%dzgt(k), n=1,N_land_tiles_f) end do - write (10) (cat_param(n)%poros, n=1,N_catd) - write (10) (cat_param(n)%cond, n=1,N_catd) - write (10) (cat_param(n)%psis, n=1,N_catd) - write (10) (cat_param(n)%bee, n=1,N_catd) - - write (10) (cat_param(n)%wpwet, n=1,N_catd) - - write (10) (cat_param(n)%gnu, n=1,N_catd) - - write (10) (cat_param(n)%vgwmax, n=1,N_catd) - - write (10) (real(cat_param(n)%vegcls), n=1,N_catd) - write (10) (real(cat_param(n)%soilcls30), n=1,N_catd) - write (10) (real(cat_param(n)%soilcls100), n=1,N_catd) - - write (10) (cat_param(n)%bf1, n=1,N_catd) - write (10) (cat_param(n)%bf2, n=1,N_catd) - write (10) (cat_param(n)%bf3, n=1,N_catd) - write (10) (cat_param(n)%cdcr1, n=1,N_catd) - write (10) (cat_param(n)%cdcr2, n=1,N_catd) - write (10) (cat_param(n)%ars1, n=1,N_catd) - write (10) (cat_param(n)%ars2, n=1,N_catd) - write (10) (cat_param(n)%ars3, n=1,N_catd) - write (10) (cat_param(n)%ara1, n=1,N_catd) - write (10) (cat_param(n)%ara2, n=1,N_catd) - write (10) (cat_param(n)%ara3, n=1,N_catd) - write (10) (cat_param(n)%ara4, n=1,N_catd) - write (10) (cat_param(n)%arw1, n=1,N_catd) - write (10) (cat_param(n)%arw2, n=1,N_catd) - write (10) (cat_param(n)%arw3, n=1,N_catd) - write (10) (cat_param(n)%arw4, n=1,N_catd) - write (10) (cat_param(n)%tsa1, n=1,N_catd) - write (10) (cat_param(n)%tsa2, n=1,N_catd) - write (10) (cat_param(n)%tsb1, n=1,N_catd) - write (10) (cat_param(n)%tsb2, n=1,N_catd) - write (10) (cat_param(n)%atau, n=1,N_catd) - write (10) (cat_param(n)%btau, n=1,N_catd) - - write (10) (cat_param(n)%gravel30, n=1,N_catd) - write (10) (cat_param(n)%orgC30 , n=1,N_catd) - write (10) (cat_param(n)%orgC , n=1,N_catd) - write (10) (cat_param(n)%sand30 , n=1,N_catd) - write (10) (cat_param(n)%clay30 , n=1,N_catd) - write (10) (cat_param(n)%sand , n=1,N_catd) - write (10) (cat_param(n)%clay , n=1,N_catd) - write (10) (cat_param(n)%wpwet30 , n=1,N_catd) - write (10) (cat_param(n)%poros30 , n=1,N_catd) - - write (10) (cat_param(n)%veghght , n=1,N_catd) + write (10) (cat_param(n)%poros, n=1,N_land_tiles_f) + write (10) (cat_param(n)%cond, n=1,N_land_tiles_f) + write (10) (cat_param(n)%psis, n=1,N_land_tiles_f) + write (10) (cat_param(n)%bee, n=1,N_land_tiles_f) + + write (10) (cat_param(n)%wpwet, n=1,N_land_tiles_f) + + write (10) (cat_param(n)%gnu, n=1,N_land_tiles_f) + + write (10) (cat_param(n)%vgwmax, n=1,N_land_tiles_f) + + write (10) (real(cat_param(n)%vegcls), n=1,N_land_tiles_f) + write (10) (real(cat_param(n)%soilcls30), n=1,N_land_tiles_f) + write (10) (real(cat_param(n)%soilcls100), n=1,N_land_tiles_f) + + write (10) (cat_param(n)%bf1, n=1,N_land_tiles_f) + write (10) (cat_param(n)%bf2, n=1,N_land_tiles_f) + write (10) (cat_param(n)%bf3, n=1,N_land_tiles_f) + write (10) (cat_param(n)%cdcr1, n=1,N_land_tiles_f) + write (10) (cat_param(n)%cdcr2, n=1,N_land_tiles_f) + write (10) (cat_param(n)%ars1, n=1,N_land_tiles_f) + write (10) (cat_param(n)%ars2, n=1,N_land_tiles_f) + write (10) (cat_param(n)%ars3, n=1,N_land_tiles_f) + write (10) (cat_param(n)%ara1, n=1,N_land_tiles_f) + write (10) (cat_param(n)%ara2, n=1,N_land_tiles_f) + write (10) (cat_param(n)%ara3, n=1,N_land_tiles_f) + write (10) (cat_param(n)%ara4, n=1,N_land_tiles_f) + write (10) (cat_param(n)%arw1, n=1,N_land_tiles_f) + write (10) (cat_param(n)%arw2, n=1,N_land_tiles_f) + write (10) (cat_param(n)%arw3, n=1,N_land_tiles_f) + write (10) (cat_param(n)%arw4, n=1,N_land_tiles_f) + write (10) (cat_param(n)%tsa1, n=1,N_land_tiles_f) + write (10) (cat_param(n)%tsa2, n=1,N_land_tiles_f) + write (10) (cat_param(n)%tsb1, n=1,N_land_tiles_f) + write (10) (cat_param(n)%tsb2, n=1,N_land_tiles_f) + write (10) (cat_param(n)%atau, n=1,N_land_tiles_f) + write (10) (cat_param(n)%btau, n=1,N_land_tiles_f) + + write (10) (cat_param(n)%gravel30, n=1,N_land_tiles_f) + write (10) (cat_param(n)%orgC30 , n=1,N_land_tiles_f) + write (10) (cat_param(n)%orgC , n=1,N_land_tiles_f) + write (10) (cat_param(n)%sand30 , n=1,N_land_tiles_f) + write (10) (cat_param(n)%clay30 , n=1,N_land_tiles_f) + write (10) (cat_param(n)%sand , n=1,N_land_tiles_f) + write (10) (cat_param(n)%clay , n=1,N_land_tiles_f) + write (10) (cat_param(n)%wpwet30 , n=1,N_land_tiles_f) + write (10) (cat_param(n)%poros30 , n=1,N_land_tiles_f) + + write (10) (cat_param(n)%veghght , n=1,N_land_tiles_f) close (10,status='keep') @@ -1486,16 +1485,17 @@ end subroutine create_mapping ! ******************************************************************** - subroutine read_mapping(mapping_file, N_types, tile_types, N_tiles_r, N_tiles_f, f2r, r2g) + subroutine read_mapping( mapping_file, N_types, tile_types, N_tiles_r, N_tiles_f, f2r, r2g) - implicit none - character(*), intent(in):: mapping_file - integer, intent(out) :: N_types + character(*), intent(in) :: mapping_file + integer, intent(out) :: N_types integer, dimension(:), allocatable, optional, intent(out) :: tile_types integer, dimension(:), allocatable, optional, intent(out) :: N_tiles_r integer, dimension(:), allocatable, optional, intent(out) :: N_tiles_f integer, dimension(:), allocatable, optional, intent(out) :: f2r integer, dimension(:), allocatable, optional, intent(out) :: r2g + + ! ------------------------------ logical :: file_exist integer, dimension(:), allocatable :: N_tiles_r_tmp, N_tiles_f_tmp @@ -1521,13 +1521,13 @@ subroutine read_mapping(mapping_file, N_types, tile_types, N_tiles_r, N_tiles_ allocate(f2r(sum(N_tiles_f_tmp))) read(40,*) f2r else - read(40,*)! read off f2r + read(40,*) ! skip over f2r endif if (present(r2g)) then allocate(r2g(sum(N_tiles_r_tmp))) read(40,*) r2g else - read(40,*)! read off r2g + read(40,*) ! skip over r2g endif if (present(N_tiles_r)) N_tiles_r = N_tiles_r_tmp @@ -1535,18 +1535,20 @@ subroutine read_mapping(mapping_file, N_types, tile_types, N_tiles_r, N_tiles_ close(40) else - print*, " wrong, no mapping file" + print*, "ERROR, mapping file does not exist: ", trim(mapping_file) endif + end subroutine read_mapping ! ******************************************************************** - subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) + subroutine createZoominTilefile( mapping_file, orig_tile, new_tile) - implicit none character(*), intent(in) :: mapping_file character(*), intent(in) :: orig_tile character(*), intent(in) :: new_tile + + ! --------------------------------------- character(len=256) :: line @@ -1588,7 +1590,7 @@ subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) do n = 1, n_tiles if (any(tile_types == iTable(n,0))) then if (f2g(f_id) /= n) then - iTable(n,0) = iTable(n,0) + MAPL_ExcludeFromDomain + iTable(n,0) = iTable(n,0) + ExcludeFromDomain else f_id = f_id + 1 if (f_id > size(f2g)) exit @@ -1637,7 +1639,7 @@ subroutine createZoominTilefile(mapping_file, orig_tile, new_tile) write(typ_str, '(I0)') ty typ_str = adjustr(typ_str) n=index(line, typ_str) - write(typ_str_exclude, '(I0)') ty + MAPL_ExcludeFromDomain + write(typ_str_exclude, '(I0)') ty + ExcludeFromDomain line(n:n+3) = typ_str_exclude else f_id = f_id + 1 @@ -1657,24 +1659,25 @@ end subroutine createZoominTilefile subroutine createZoominBC(mapping_file, orig_BC, new_BC) - implicit none character(*),intent(in) :: mapping_file character(*),intent(in) :: orig_BC character(*),intent(in) :: new_BC + + ! ------------------------------------------- real,dimension(14) :: tmprealvec14 real,allocatable :: tmpvec(:) - integer :: istat, N_catr, N_catf, N_types + integer :: istat, N_tiles_land_r, N_tiles_land_f, N_types integer,dimension(:),allocatable :: f2r_land, f2r, r2g, tile_types, N_tiles_r, N_tiles_f call read_mapping( mapping_file, N_types, tile_types=tile_types, N_tiles_r=N_tiles_r, N_tiles_f=N_tiles_f, f2r=f2r, r2g=r2g) if (tile_types(1) /= MAPL_LAND) return if (N_tiles_r(1) == N_tiles_f(1) ) return - N_catf = N_tiles_f(1) - N_catr = N_tiles_r(1) - f2r_land = f2r(1:N_catf) + N_tiles_land_f = N_tiles_f(1) + N_tiles_land_r = N_tiles_r(1) + f2r_land = f2r(1:N_tiles_land_f) - allocate(tmpvec(N_catr)) + allocate(tmpvec(N_tiles_land_r)) open(10,file=trim(orig_BC),form='unformatted',action='read',status='old',iostat=istat) open(20,file=trim(new_BC),form='unformatted',action='write') @@ -1690,14 +1693,17 @@ subroutine createZoominBC(mapping_file, orig_BC, new_BC) deallocate(tmpvec) end subroutine createZoominBC -! *************************************** + ! *************************************** + subroutine createZoominRestart(mapping_file, orig_rst, new_rst, tile_type) - implicit none - character(*),intent(in):: mapping_file - character(*),intent(in):: orig_rst - character(*),intent(in):: new_rst - integer, intent(in) :: tile_type + character(*), intent(in) :: mapping_file + character(*), intent(in) :: orig_rst + character(*), intent(in) :: new_rst + integer, intent(in) :: tile_type + + ! ------------------------------------------- + integer :: istat, file_type, rc,i, j, ndims real,allocatable :: tmp1(:) type(Netcdf4_FileFormatter) :: InFmt,OutFmt @@ -1804,19 +1810,21 @@ end subroutine createZoominRestart ! ******************************************************************** - subroutine createZoominVegRestart(mapping_file, orig_veg, new_veg) + subroutine createZoominVegRestart( mapping_file, orig_veg, new_veg) + + character(*), intent(in) :: mapping_file + character(*), intent(in) :: orig_veg + character(*), intent(in) :: new_veg + + ! ------------------------------------------ - implicit none - character(*),intent(in):: mapping_file - character(*),intent(in):: orig_veg - character(*),intent(in):: new_veg integer :: istat real,allocatable :: rity(:) real,allocatable :: z2(:) real,allocatable :: ascatz0(:) real,allocatable :: tmp(:) - integer :: N_catr, N_catf, N_types + integer :: N_tiles_land_r, N_tiles_land_f, N_types integer,dimension(:),allocatable :: f2r, r2g, f2r_land, tile_types, N_tiles_r, N_tiles_f integer :: file_type @@ -1834,14 +1842,14 @@ subroutine createZoominVegRestart(mapping_file, orig_veg, new_veg) if (tile_types(1) /= MAPL_LAND) return if (N_tiles_r(1) == N_tiles_f(1) ) return - N_catf = N_tiles_f(1) - N_catr = N_tiles_r(1) + N_tiles_land_f = N_tiles_f(1) + N_tiles_land_r = N_tiles_r(1) - allocate(rity(N_catr)) - allocate(z2(N_catr)) - allocate(ascatz0(N_catr)) + allocate(rity(N_tiles_land_r)) + allocate(z2(N_tiles_land_r)) + allocate(ascatz0(N_tiles_land_r)) - f2r_land = f2r(1:N_catf) + f2r_land = f2r(1:N_tiles_land_f) call MAPL_NCIOGetFileType(orig_veg, file_type,rc=rc) isNC4 = (file_type == MAPL_FILETYPE_NC4) @@ -1864,14 +1872,14 @@ subroutine createZoominVegRestart(mapping_file, orig_veg, new_veg) InCfg = InFmt%read(rc=rc) OutCfg = InCfg - call OutCfg%modify_dimension('tile', N_catf, rc=rc) + call OutCfg%modify_dimension('tile', N_tiles_land_f, rc=rc) call OutFmt%create(trim(new_veg),rc=rc) call OutFmt%write(OutCfg,rc=rc) variables => InCfg%get_variables() var_iter = variables%begin() - allocate(tmp(N_catr)) + allocate(tmp(N_tiles_land_r)) do while (var_iter /= variables%end()) vname => var_iter%key() call MAPL_VarRead (InFmt,vname,tmp) @@ -1901,9 +1909,11 @@ subroutine correctEase(orig_ease,new_ease) ! ! - reichle, 2 Aug 2020 - implicit none character(*),intent(in) :: orig_ease character(*),intent(in) :: new_ease + + ! ------------------------------------- + logical :: file_exist,is_oldEASE, isNC4 integer :: i, n_tiles, n_grids, file_type, status character(len=256) :: tmpline @@ -1946,6 +1956,7 @@ subroutine correctEase(orig_ease,new_ease) close(56) close(55) end if + end subroutine correctEase ! ******************************************************************** @@ -1976,13 +1987,12 @@ end subroutine correctEase subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_dir, types) - implicit none - - character(*), intent(in) :: fname_tilefile ! file name (with path) of tile file (*.til) - character(*), intent(in) :: N_proc_string ! *string* w/ no. of processors (or tasks), excl. OSERVER tasks - character(*), intent(in) :: optimized_file - character(*), intent(in) :: run_dir - integer, optional, intent(in) :: types(:) + character(*), intent(in) :: fname_tilefile ! file name (with path) of tile file (*.til) + character(*), intent(in) :: N_proc_string ! *string* w/ no. of processors (or tasks), excl. OSERVER tasks + character(*), intent(in) :: optimized_file + character(*), intent(in) :: run_dir + integer, optional, intent(in) :: types(:) + ! local variables integer :: N_proc integer :: n_tiles,N_lon,N_lat,n_grids @@ -2422,8 +2432,10 @@ subroutine optimize_latlon(fname_tilefile, N_proc_string, optimized_file, run_di ! --------------------------------------------------- elemental function rms(rates) result (f) - real :: f - real,intent(in) :: rates + + real :: f + real, intent(in) :: rates + integer :: tmpint,local integer :: n0,proc,n integer :: avg_tile @@ -2472,8 +2484,10 @@ end function rms ! --------------------------------------------------- subroutine equal_partition(array, distribute) + integer, intent(in) :: array(:) integer, intent(inout) :: distribute(:) + integer, allocatable :: ArraySum(:) integer, allocatable :: table(:,:), partition(:,:) integer :: n, k, tmp_max @@ -2548,13 +2562,12 @@ end subroutine optimize_latlon subroutine convert_pert_rst(pfile_name,pfile_nc4,in_path,exp_id) - implicit none character(*),intent(in) :: pfile_name character(*),intent(in) :: in_path character(*),intent(in) :: exp_id character(*),intent(in) :: pfile_nc4 - integer :: N_catf,N_lon,N_lat,N_lonf,N_latf + integer :: N_tiles_land_f,N_lon,N_lat,N_lonf,N_latf integer :: N_force_pert,N_progn_pert integer,pointer :: f2g(:) @@ -2567,7 +2580,7 @@ subroutine convert_pert_rst(pfile_name,pfile_nc4,in_path,exp_id) real,allocatable :: Force_pert_ntrmdt_f(:,:,:) real,allocatable :: Progn_pert_ntrmdt_f(:,:,:) - call io_domain_files('r',in_path, trim(exp_id),N_catf,f2g,tile_coord_f,pert_grid_g,pert_grid_f,RC) + call io_domain_files('r',in_path, trim(exp_id),N_tiles_land_f,f2g,tile_coord_f,pert_grid_g,pert_grid_f,RC) N_lon = pert_grid_g%N_lon N_lat = pert_grid_g%N_lat @@ -2583,6 +2596,7 @@ subroutine convert_pert_rst(pfile_name,pfile_nc4,in_path,exp_id) ! *************************************************************************** subroutine i_pert_ldas(rc) + integer,intent(inout),optional :: rc integer :: nrandseed_tmp @@ -2661,7 +2675,9 @@ end subroutine i_pert_ldas ! ******************************************************************** subroutine o_pert_GEOSldas(rc) + integer,intent(inout) :: rc + integer :: NCFOutID, STATUS integer :: seeddim,latdim, londim, Nforce,NProgn integer :: dims(3), seedid,forceid,prognid @@ -2753,7 +2769,7 @@ end subroutine convert_pert_rst ! ************************************************************************************************** - subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, r2g, N_tiles_land_g, types ) + subroutine LDAS_read_til_file( tile_file, catch_def_file, tile_grid_g, tile_coord_r, r2g, N_tiles_land_g, types ) ! read tile information from *.til file ! @@ -2762,18 +2778,18 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! - was known as LDAS_read_land_tile() when in LDAS_TileCoordRoutines.F90. ! ! inputs: - ! tile_file : *.til tile definition file (full path + name) - ! catch_file : catchment.def file (full path + name) + ! tile_file : *.til tile definition file (full path + name) + ! catch_def_file : catchment.def file (full path + name) ! ! outputs: - ! tile_grid_g : parameters of tile definition grid - ! tile_coord_r : coordinates of tiles (see tile_coord_type), - ! implemented as pointer which is allocated in - ! this subroutine + ! tile_grid_g : parameters of tile definition grid + ! tile_coord_r : coordinates of tiles (see tile_coord_type), + ! implemented as pointer which is allocated in + ! this subroutine ! ! optional: - ! r2g : the restart domain id to the global id - ! N_tiles_land_g : Number of *land* tiles in global domain + ! r2g : the restart domain id to the global id + ! N_tiles_land_g : Number of *land* tiles in global domain ! "tile_id" is no longer read from *.til file and is now set in this ! subroutine to match order of tiles in *.til file @@ -2788,10 +2804,8 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, ! ! ------------------------------------------------------------- - implicit none - character(*), intent(in) :: tile_file - character(*), intent(in) :: catch_file + character(*), intent(in) :: catch_def_file type(grid_def_type), intent(inout):: tile_grid_g type(tile_coord_type), dimension(:), pointer :: tile_coord_r ! out integer, intent(out) :: N_tiles_land_g @@ -2895,7 +2909,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, if (isNC4 ) then - N_tiles_land_g = count(iTable(:,0) == MAPL_LAND .or. iTable(:,0) == (MAPL_LAND + MAPL_ExcludeFromDomain)) + N_tiles_land_g = count(iTable(:,0) == MAPL_LAND .or. iTable(:,0) == (MAPL_LAND + ExcludeFromDomain)) tile_coord_r(:)%typ = iTable(r2g, 0) tile_coord_r(:)%i_indg = iTable(r2g, 2) tile_coord_r(:)%j_indg = iTable(r2g, 3) @@ -2932,9 +2946,9 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, read(10,'(A)') tmpline read(tmpline,*) typ - if (typ == MAPL_LAND .or. typ == MAPL_LAND + MAPL_ExcludeFromDomain) N_tiles_land_g = N_tiles_land_g + 1 + if (typ == MAPL_LAND .or. typ == MAPL_LAND + ExcludeFromDomain) N_tiles_land_g = N_tiles_land_g + 1 - ! tile type "MAPL_ExcludeFromDomain" identifies tiles to exclude + ! adding "ExcludeFromDomain" to tile type identifies tiles to be excluded ! when non-global domain is created if (any( tile_types == typ)) then ! all needed tiles @@ -3052,7 +3066,7 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, tile_coord_r%pert_i_indg = nint(nodata_generic) tile_coord_r%pert_j_indg = nint(nodata_generic) tile_coord_r%elev = nodata_generic - call read_catchment_def( catch_file, N_tiles_land_g, tile_coord_r ) + call read_catchment_def( catch_def_file, N_tiles_land_g, tile_coord_r ) ! ---------------------------------------------------------------------- ! @@ -3066,8 +3080,8 @@ subroutine LDAS_read_til_file( tile_file, catch_file, tile_grid_g, tile_coord_r, if ( tile_coord_r(1)%typ == MAPL_LAND .and. abs(tile_coord_r(1)%elev-nodata_generic)topo_DYN_ave.file') open(10,file='topo_DYN_ave.file', action='read') fname= '' @@ -3101,12 +3115,10 @@ subroutine read_grid_elev( fname, tile_grid, n_tiles, tile_coord ) ! reichle, 8 Dec 2011: bug fix -- bin elev data is stored in single record - implicit none - - character(*), intent(in) :: fname + character(*), intent(in) :: fname + type(grid_def_type), intent(in) :: tile_grid + integer, intent(in) :: n_tiles - type(grid_def_type), intent(in) :: tile_grid - integer, intent(in) :: n_tiles type(tile_coord_type), dimension(:), pointer :: tile_coord ! inout ! local variables @@ -3157,6 +3169,7 @@ subroutine read_grid_elev( fname, tile_grid, n_tiles, tile_coord ) end subroutine read_grid_elev ! ******************************************************************* + subroutine fix_dateline_bug_in_tilecoord( n_tiles, tile_grid, tile_coord ) ! bug in com_lon and minlon/maxlon for tiles straddling the dateline @@ -3166,8 +3179,6 @@ subroutine fix_dateline_bug_in_tilecoord( n_tiles, tile_grid, tile_coord ) ! ! reichle, 5 Feb 2008 - implicit none - integer, intent(in) :: n_tiles type(grid_def_type), intent(in) :: tile_grid @@ -3233,7 +3244,7 @@ end subroutine fix_dateline_bug_in_tilecoord ! ********************************************************************** - subroutine read_catchment_def( catchment_def_file, N_catg, tile_coord_r ) + subroutine read_catchment_def( catch_def_file, N_tiles_land_g, tile_coord_r ) ! reichle, 17 May 2011: read elevation data if available @@ -3245,11 +3256,9 @@ subroutine read_catchment_def( catchment_def_file, N_catg, tile_coord_r ) ! ! Elevation [m] is ONLY available for EASE grid tile definitions - implicit none - - character(*), intent(in) :: catchment_def_file + character(*), intent(in) :: catch_def_file - integer, intent(in) :: N_catg + integer, intent(in) :: N_tiles_land_g type(tile_coord_type), dimension(:), pointer :: tile_coord_r ! inout @@ -3268,7 +3277,7 @@ subroutine read_catchment_def( catchment_def_file, N_catg, tile_coord_r ) ! read file header if (logit) write (logunit,'(400A)') & - 'read_catchment_def(): reading from' // trim(catchment_def_file) + 'read_catchment_def(): reading from' // trim(catch_def_file) if (logit) write (logunit,*) ! sweep=1: Try reading 7 columns. If this fails, try again. @@ -3278,12 +3287,12 @@ subroutine read_catchment_def( catchment_def_file, N_catg, tile_coord_r ) if (logit) write (logunit,*) 'starting sweep ', sweep - open (10, file=trim(catchment_def_file), form='formatted', action='read') + open (10, file=trim(catch_def_file), form='formatted', action='read') read (10,*) N_land_tile - if ( N_land_tile /= N_catg) then - err_msg = 'tile_coord_file and catchment_def_file mismatch. (1)' + if ( N_land_tile /= N_tiles_land_g) then + err_msg = 'tile_coord_file and catch_def_file mismatch. (1)' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) endif @@ -3325,7 +3334,7 @@ subroutine read_catchment_def( catchment_def_file, N_catg, tile_coord_r ) tile_coord_r(k)%max_lat = max_lat tile_coord_r(k)%elev = elev if (tile_coord_r(k)%pfaf_index /=tmp_pfaf) then - err_msg = 'tile_coord_file and catchment_def_file mismatch. (2)' + err_msg = 'tile_coord_file and catch_def_file mismatch. (2)' call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) endif k = k + 1 From 250f7b536a59cd344d43b35491e2603010ec062a Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Mon, 12 May 2025 10:22:24 -0400 Subject: [PATCH 51/55] added blank after "stop" to fix gnu build error (preprocess_ldas_routines.F90) --- GEOSldas_App/preprocess_ldas_routines.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSldas_App/preprocess_ldas_routines.F90 b/GEOSldas_App/preprocess_ldas_routines.F90 index 97f22df8..382a549d 100644 --- a/GEOSldas_App/preprocess_ldas_routines.F90 +++ b/GEOSldas_App/preprocess_ldas_routines.F90 @@ -165,7 +165,7 @@ subroutine create_mapping( orig_tile, domain_def, out_path, catch_def_file, exp_ exclude_file,include_file inquire(file=trim(orig_tile),exist=file_exist) - if( .not. file_exist) stop("original tile file does not exist") + if( .not. file_exist) stop ("original tile file does not exist") inquire(file=trim(domain_def),exist=d_exist) if( .not. d_exist) then From a92e3e6d9a76abed52ad3879cf885fcc42002f35 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 15 May 2025 09:57:33 -0400 Subject: [PATCH 52/55] change tile_types to numbers that are consistent throughout --- GEOS_LdasGridComp.F90 | 31 +++++++++++++++++------------ GEOSldas_App/GEOSldas_LDAS.rc | 13 ++++++------ GEOSldas_App/ldas_setup | 3 +-- LDAS_Shared/LDAS_Convert.F90 | 37 ----------------------------------- 4 files changed, 26 insertions(+), 58 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index d6458b47..04a1237d 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -20,7 +20,7 @@ module GEOS_LdasGridCompMod use LDAS_TileCoordType, only: tile_coord_type , T_TILECOORD_STATE, TILECOORD_WRAP use LDAS_TileCoordType, only: grid_def_type, io_grid_def_type, operator (==) use LDAS_TileCoordRoutines, only: get_minExtent_grid, get_ij_ind_from_latlon, io_domain_files - use LDAS_ConvertMod, only: esmf2ldas, string2tile_types + use LDAS_ConvertMod, only: esmf2ldas use LDAS_PertRoutinesMod, only: get_pert_grid use LDAS_ensdrv_functions, only: get_io_filename use LDAS_DateTimeMod, only: date_time_type @@ -89,16 +89,17 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: ensid_string,childname - character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR, TILE_TYPES_STR + character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR integer :: ens_id_width - character(10), allocatable :: tile_types(:) + integer, allocatable :: tile_types(:) ! Local variables type(T_TILECOORD_STATE), pointer :: tcinternal type(TILECOORD_WRAP) :: tcwrap type(ESMF_Config) :: CF - integer :: LSM_CHOICE + integer :: LSM_CHOICE, NRA integer :: FIRST_ENS_ID + logical :: isPresent ! Begin... @@ -155,18 +156,24 @@ subroutine SetServices(gc, rc) VERIFY_(STATUS) ensemble_forcing = (trim(ENS_FORCING_STR) == 'YES') - call MAPL_GetResource ( MAPL, TILE_TYPES_STR, Label="TILE_TYPES:", DEFAULT="LAND", RC=STATUS) - VERIFY_(STATUS) - TILE_TYPES_STR = ESMF_UtilStringUpperCase(TILE_TYPES_STR, rc=STATUS) - VERIFY_(STATUS) - call string2tile_types(TILE_TYPES_STR, tile_types) + call ESMF_ConfigFindLabel( CF, LABEL="TILE_TYPES:", isPresent=isPresent, _RC) + if (isPresent) then + nra = ESMF_ConfigGetLen( CF, _RC) + allocate(tile_types(nra)) + call ESMF_ConfigFindLabel( CF, LABEL="TILE_TYPES:", _RC) + call ESMF_ConfigGetAttribute( CF, valueList=tile_types, count=NRA, _RC) + else + ! default + tile_types = [MAPL_LAND] + endif + with_landice = .false. with_land = .false. ! with_lake = .false. do i = 1, size(tile_types) - if (trim(tile_types(i)) == 'LANDICE') with_landice = .true. - if (trim(tile_types(i)) == 'LAND') with_land = .true. -! if (trim(tile_types(i)) == 'LAKE') with_lake = .true. + if (tile_types(i) == MAPL_LANDICE) with_landice = .true. + if (tile_types(i) == MAPL_LAND) with_land = .true. +! if (tile_types(i) == MAPL_LAKE) with_lake = .true. enddo call MAPL_GetResource ( MAPL, LAND_ASSIM_STR, Label="LAND_ASSIM:", DEFAULT="NO", RC=STATUS) diff --git a/GEOSldas_App/GEOSldas_LDAS.rc b/GEOSldas_App/GEOSldas_LDAS.rc index f6045465..8d7f514d 100644 --- a/GEOSldas_App/GEOSldas_LDAS.rc +++ b/GEOSldas_App/GEOSldas_LDAS.rc @@ -39,15 +39,14 @@ LSM_CHOICE: 1 # ---- Choice of tile type(s) # -# Comma-separated list of tile types to be included in simulation. -# Do not use space before/after comma. Examples: +# list of tile types to be included in simulation. +# use blank space as seperator if there are more than one type # -# LAND : include only land tiles -# LAND,LANDICE : include land and landice tiles -# LANDICE : include only landice tiles +# land tiles 100 +# landice tiles 20 +# lake tiles 29 (not yet implemented) # -TILE_TYPES: LAND - +TILE_TYPES: 100 # ---- Format of tile file (from bcs directory) # diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index c482bb22..4ed2ea02 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -163,8 +163,7 @@ class LDASsetup: print ('\nInputs from execfile:\n') _printdict(self.rqdExeInp) - tile_types = {'LAND':'100', 'LANDICE':'20'} - self.tile_types = [tile_types[x.strip().upper()] for x in self.rqdExeInp.get('TILE_TYPES','LAND').split(',')] + self.tile_types = self.rqdExeInp.get('TILE_TYPES',["100"]).split() if "100" in self.tile_types : self.with_land = True if "20" in self.tile_types : diff --git a/LDAS_Shared/LDAS_Convert.F90 b/LDAS_Shared/LDAS_Convert.F90 index 0993e13f..cf155d94 100644 --- a/LDAS_Shared/LDAS_Convert.F90 +++ b/LDAS_Shared/LDAS_Convert.F90 @@ -12,7 +12,6 @@ module LDAS_ConvertMod private public :: esmf2ldas - public :: string2tile_types interface esmf2ldas module procedure esmf2ldas_time @@ -49,42 +48,6 @@ end subroutine esmf2ldas_time ! -------------------------------------------- - subroutine string2tile_types( string, tile_types) - - ! break string with list of (comma-separated) tile types into vector of strings - - character(len=ESMF_MAXSTR), intent(in) :: string - character(10), allocatable, intent(out) :: tile_types(:) - - character(10) :: outs4(4) - integer :: ntype , j, j0 - - j = index(string, ',') ! identify positions of commas (delimiter) - ntype = 1 - j0 = 0 - - ! loop through positions of commas - - do while (.true.) - if (j == 0) then - outs4(ntype) = trim(adjustl(string(j0+1:))) - exit - endif - outs4(ntype) = trim(adjustl(string(j0+1:j0+j-1))) - - j0 = j0+j - j = index(string(j0+1:), ',') - ntype = ntype+1 - enddo - - ! assemble output vector of strings - - allocate(tile_types(ntype), source=outs4(1:ntype)) - - end subroutine string2tile_types - - ! -------------------------------------------- - end module LDAS_ConvertMod ! ========= EOF =========================================================== From 462804a2ab7a1f02b425b782a25d13b2fe32622d Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 15 May 2025 11:01:00 -0400 Subject: [PATCH 53/55] edited help text and white-space changes (GEOSldas_App/GEOSldas_LDAS.rc, GEOS_LdasGridComp.F90) --- GEOS_LdasGridComp.F90 | 8 ++++---- GEOSldas_App/GEOSldas_LDAS.rc | 13 ++++++++----- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 04a1237d..6e625440 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -97,7 +97,7 @@ subroutine SetServices(gc, rc) type(TILECOORD_WRAP) :: tcwrap type(ESMF_Config) :: CF - integer :: LSM_CHOICE, NRA + integer :: LSM_CHOICE, nra integer :: FIRST_ENS_ID logical :: isPresent @@ -160,8 +160,8 @@ subroutine SetServices(gc, rc) if (isPresent) then nra = ESMF_ConfigGetLen( CF, _RC) allocate(tile_types(nra)) - call ESMF_ConfigFindLabel( CF, LABEL="TILE_TYPES:", _RC) - call ESMF_ConfigGetAttribute( CF, valueList=tile_types, count=NRA, _RC) + call ESMF_ConfigFindLabel( CF, LABEL="TILE_TYPES:", _RC) + call ESMF_ConfigGetAttribute( CF, valueList=tile_types, count=nra, _RC) else ! default tile_types = [MAPL_LAND] @@ -169,7 +169,7 @@ subroutine SetServices(gc, rc) with_landice = .false. with_land = .false. -! with_lake = .false. +! with_lake = .false. do i = 1, size(tile_types) if (tile_types(i) == MAPL_LANDICE) with_landice = .true. if (tile_types(i) == MAPL_LAND) with_land = .true. diff --git a/GEOSldas_App/GEOSldas_LDAS.rc b/GEOSldas_App/GEOSldas_LDAS.rc index 8d7f514d..c77ae6bd 100644 --- a/GEOSldas_App/GEOSldas_LDAS.rc +++ b/GEOSldas_App/GEOSldas_LDAS.rc @@ -39,12 +39,15 @@ LSM_CHOICE: 1 # ---- Choice of tile type(s) # -# list of tile types to be included in simulation. -# use blank space as seperator if there are more than one type +# List of tile types to be included in simulation. +# Use blank space as separator if there is more than one type. # -# land tiles 100 -# landice tiles 20 -# lake tiles 29 (not yet implemented) +# land : 100 (non-glaciated land) +# landice : 20 ( glaciated land) +# lake : 19 [not yet implemented] +# +# For example, include land and landice tiles as follows: +# TILE_TYPES: 100 20 # TILE_TYPES: 100 From a53e9113775217729fa7286429664115ced1455d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 15 May 2025 12:33:32 -0400 Subject: [PATCH 54/55] refactoring... --- GEOS_LdasGridComp.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index 6e625440..cf481aa1 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -170,11 +170,10 @@ subroutine SetServices(gc, rc) with_landice = .false. with_land = .false. ! with_lake = .false. - do i = 1, size(tile_types) - if (tile_types(i) == MAPL_LANDICE) with_landice = .true. - if (tile_types(i) == MAPL_LAND) with_land = .true. -! if (tile_types(i) == MAPL_LAKE) with_lake = .true. - enddo + + if (any(tile_types == MAPL_LANDICE)) with_landice = .true. + if (any(tile_types == MAPL_LAND )) with_land = .true. +! if (any(tile_types == MAPL_LAKE )) with_lake = .true. call MAPL_GetResource ( MAPL, LAND_ASSIM_STR, Label="LAND_ASSIM:", DEFAULT="NO", RC=STATUS) VERIFY_(STATUS) From 1651d9398a19b482b0a68f5c79823842a62b2eae Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 16 May 2025 10:29:35 -0400 Subject: [PATCH 55/55] a bug fix --- GEOSldas_App/ldas_setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GEOSldas_App/ldas_setup b/GEOSldas_App/ldas_setup index 4ed2ea02..e1dbe6be 100755 --- a/GEOSldas_App/ldas_setup +++ b/GEOSldas_App/ldas_setup @@ -163,7 +163,7 @@ class LDASsetup: print ('\nInputs from execfile:\n') _printdict(self.rqdExeInp) - self.tile_types = self.rqdExeInp.get('TILE_TYPES',["100"]).split() + self.tile_types = self.rqdExeInp.get('TILE_TYPES',"100").split() if "100" in self.tile_types : self.with_land = True if "20" in self.tile_types :