From 5f2c6c90e939fd3dfa79a03d68c52c7fa95a6916 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Wed, 13 May 2020 14:10:32 -0400 Subject: [PATCH 01/19] initial modifications for output of L-band Tb via HISTORY --- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 12 ++ .../GEOSens_GridComp/GEOS_EnsGridComp.F90 | 5 + .../GEOS_LandAssimGridComp.F90 | 117 +++++++++++++++++- .../GEOSlandassim_GridComp/mwRTM_routines.F90 | 9 +- 4 files changed, 136 insertions(+), 7 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index fd5b2e09..287b6306 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -870,6 +870,13 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) + ! RRTBHISTORY + ! + ! run new "phase=3" of LandAssim GC here to calculate L-band Tb for each member + ! + ! must be done before ApplyPrognPert for consistency with "land" exports + + ! Use land's output as the input to calculate the ensemble average if (LSM_CHOICE == 1) then ! collect cat_param @@ -877,6 +884,11 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=2, userRC=status) VERIFY_(status) + + ! RRTBHISTORY + ! + ! run new "phase=4" of Ens GC here to calculate L-band Tb ens avg + endif ! Should this be moved to the beginning of the loop to avoid the pollution ? diff --git a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 index e43a9692..8703eea4 100644 --- a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 @@ -98,6 +98,11 @@ subroutine SetServices(gc, rc) ) VERIFY_(status) + ! RRTBHISTORY + ! + ! add new phase that collects L-band Tb_h and Tb_v + + call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_FINALIZE, & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index b0e7636b..d6e9a401 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -84,6 +84,9 @@ module GEOS_LandAssimGridCompMod type(obs_param_type),pointer :: obs_param(:)=>null() logical :: need_mwRTM_param +! RRTBHISTORY: I DID NOT SEE WHERE need_mwRTM_param WAS INITIALIZED. SHOULD BE INITIALIZED TO .false. ?? +! CAN WE CHECK IF HISTORY REQUESTS Tb OUTPUT AND CHANGE need_mwRTM_param TO .true. ACCODINGLY ?? +! THIS MIGHT REQUIRE MORE DISCUSSION integer :: update_type, dtstep_assim logical :: centered_update real :: xcompact, ycompact @@ -169,6 +172,13 @@ subroutine SetServices ( GC, RC ) ) VERIFY_(status) + ! RRTBHISTORY + ! + ! add new "phase" for calculation of L-band Tb_h and Tb_v for each ensemble member + ! + ! not sure where the loop through members should go + + call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_FINALIZE, & @@ -464,9 +474,31 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) -! -! Export for incr -! + + ! RRTBHISTORY + ! + ! Exports for brightness temperature + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Hpol' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TB_LAND_1410MHZ_40DEG_HPOL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Vpol' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TB_LAND_1410MHZ_40DEG_VPOL' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + VERIFY_(STATUS) + + ! Export for incr + ! call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_canopy_temperature_saturated_zone' ,& @@ -1101,7 +1133,7 @@ subroutine Initialize(gc, import, export, clock, rc) N_catf, tile_coord_rf, & N_progn_pert, progn_pert_param, & N_force_pert, force_pert_param, & - need_mwRTM_param, & + need_mwRTM_param, & ! RRTBHISTORY: need_mwRTM_param=.true. WHEN Tb OBS ARE ASSIMILATED update_type, & dtstep_assim, & centered_update, & @@ -1975,6 +2007,83 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) end subroutine UPDATE_ASSIM + +! RRTBHISTORY +! +! new subroutine to calculate Tb + +subroutine CALC_LAND_TB(gc, import, export, clock, rc) + + ! TO GET GOOD TB VALUES WE *MUST* HAVE "mwRTM_param" + ! + ! THIS NEEDS TO WORK EVEN IF WE DO NOT HAVE "mwRTM_param" + ! + ! NOT SURE IF WE ALWAYS HAVE "mwRTM_param" WHEN THE LandAssim GC IS RUNNING + ! + ! IT IS OK TO FILL TB WITH NO-DATA-VALUES IF "mwRTM_param" IS NOT AVAILABLE + + + ! not sure where the loop through members should go -- maybe write subroutine + ! to operate on each member separately and create another subroutine that loops + ! through the members ? + + + ! TO CALCULATE TB, THE FOLLOWING TWO SUBROUTINES NEED TO BE RUN (IN ORDER): + ! call catch2mwRTM_vars() + ! call mwRTM_get_Tb() + + + ! local parameters + + real, parameter :: freq = 1.41e9 ! microwave frequency [Hz] + + real, parameter :: inc_angle = 40. ! incidence angle [deg] + + logical, parameter :: incl_atm_terms = .false. ! no atmospheric correction, ie, get Tb at top-of-vegetation + + ! convert Catchment model variables into inputs suitable for the mwRTM + ! NOTE: input tp must be in degree Celsius! + + call catch2mwRTM_vars( & + Nt, & ! intent(in), number of tiles (local?) + cat_param%vegcls, & ! intent(in), 'ITY' from imports (*cat_param* vegcls) --- not used anymore but keep for now + cat_param%poros, & ! intent(in), 'POROS' from imports (*cat_param* poros) + mwRTM_param%poros, & ! intent(in), 'MWRTM_POROS' = mw_poros + cat_diagS_avg%sfmc, & ! intent(in), 'WCSRF' need to import from "land" + cat_diagS_avg%tsurf, & ! intent(in), 'TPSURF' need to import from "land" --- not used anymore but keep for now + cat_diagS_avg%tp(1)-MAPL_TICE??, & ! intent(in), 'TP1' need to import from "land" -- units deg C !!! + sfmc_mwRTM, & ! intent(out), local variable + tsoil_mwRTM ) ! intent(out), local variable + + ! calculate brightness temperatures + ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] + ! but without Pellarin atmospheric corrections) + + ! IF NEEDED, USE DUMMY VARIABLES FOR tile_coord%elev AND Tair ALONG WITH AN IF STATEMENT AS FOLLOWS: + + if (.not. incl_atm_terms) then + + call mwRTM_get_Tb(& + Nt, freq, inc_angle, mwRTM_param, & ! intent(in) + tile_coord%elev, & ! intent(in), elevation of tile, ignore if not readily available, NOT NEEDED AS LONG AS "incl_atm_terms=.false." + veg_param_avg%lai, & ! intent(in) 'LAI' + sfmc_mwRTM, tsoil_mwRTM, & ! intent(in), output from catch2mwRTM_var() + SWE, & ! intent(in), 'SNOMASS' need to import from "land" + met_force_avg%Tair, & ! intent(in), 'TAIR' could be imported from MetForce GC, NOT NEEDED AS LONG AS "incl_atm_terms=.false." + incl_atm_terms, & ! intent(in) + Tb_h, Tb_v ) ! intent(out) --> 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' + + else + + + ! ADD CALL TO LDAS_ERROR, STOP PROGRAM IF ENDING UP HERE + + end if + + +end subroutine CALC_LAND_TB + + subroutine read_pert_rseed(seed_fname,pert_rseed_r8) use netcdf character(len=*),intent(in) :: seed_fname diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 index 42387c89..c3a8feca 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/mwRTM_routines.F90 @@ -323,10 +323,13 @@ subroutine mwRTM_get_Tb( N_tile, freq, inc_angle, mwp, elev, & if (logit) write(logunit,*) 'entering mwRTM_get_Tb...' ! check first element of elevation against no-data-value + ! (elevation is needed only when incl_atm_terms=.true.) - if ( abs(elev(1)-nodata_generic) Date: Thu, 14 May 2020 11:54:35 -0400 Subject: [PATCH 02/19] Calculate ensemble average TB_v and TB_h --- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 17 +- .../GEOS_LandAssimGridComp.F90 | 258 ++++++++++++++---- 2 files changed, 217 insertions(+), 58 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index 287b6306..4f00576b 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -870,13 +870,6 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) - ! RRTBHISTORY - ! - ! run new "phase=3" of LandAssim GC here to calculate L-band Tb for each member - ! - ! must be done before ApplyPrognPert for consistency with "land" exports - - ! Use land's output as the input to calculate the ensemble average if (LSM_CHOICE == 1) then ! collect cat_param @@ -885,10 +878,12 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=2, userRC=status) VERIFY_(status) - ! RRTBHISTORY - ! - ! run new "phase=4" of Ens GC here to calculate L-band Tb ens avg - + if(assim) then + ! calculate L-band Tb and accumulate among ensemble + ! average when i == num_ensemble + call ESMF_GridCompRun(gcs(LANDASSIM), importState=gex(igc), exportState=gex(LANDASSIM), clock=clock,phase=3, userRC=status) + VERIFY_(status) + endif endif ! Should this be moved to the beginning of the loop to avoid the pollution ? diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index d6e9a401..2c8b8fce 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -62,6 +62,8 @@ module GEOS_LandAssimGridCompMod use clsm_ensupd_enkf_update, only: output_incr_etc use clsm_ensupd_enkf_update, only: write_smapL4SMaup use clsm_ensdrv_out_routines, only: init_log, GEOS_output_smapL4SMlmc + use mwRTM_routines, only : mwRTM_get_Tb, catch2mwRTM_vars + use, intrinsic :: ieee_arithmetic implicit none @@ -173,11 +175,14 @@ subroutine SetServices ( GC, RC ) VERIFY_(status) ! RRTBHISTORY - ! - ! add new "phase" for calculation of L-band Tb_h and Tb_v for each ensemble member - ! - ! not sure where the loop through members should go - + !phase 3: calculation of L-band Tb_h and Tb_v for each ensemble membe + call MAPL_GridCompSetEntryPoint( & + gc, & + ESMF_METHOD_RUN, & + CALC_LAND_TB, & + rc=status & + ) + VERIFY_(status) call MAPL_GridCompSetEntryPoint( & gc, & @@ -2013,8 +2018,165 @@ end subroutine UPDATE_ASSIM ! new subroutine to calculate Tb subroutine CALC_LAND_TB(gc, import, export, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: import ! Import state + ! this import is from land grid come + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + + real, parameter :: freq = 1.41e9 ! microwave frequency [Hz] + real, parameter :: inc_angle = 40. ! incidence angle [deg] + logical, parameter :: incl_atm_terms = .false. ! no atmospheric correction, ie, get Tb at top-of-vegetation + + integer :: status + character(len=ESMF_MAXSTR) :: Iam='CALC_LAND_TB' + character(len=ESMF_MAXSTR) :: comp_name + ! MAPL variables + type(MAPL_MetaComp), pointer :: MAPL=>null() ! MAPL obj + type(ESMF_State) :: INTERNAL + type(mwRTM_param_type),dimension(:),allocatable :: mwRTM_param + + real, dimension(:),pointer :: LAI + real, dimension(:),pointer :: TP1 + real, dimension(:),pointer :: TPSURF + real, dimension(:),pointer :: WCSF + real, dimension(:),pointer :: WESNN1 + real, dimension(:),pointer :: WESNN2 + real, dimension(:),pointer :: WESNN3 + + real, dimension(:), pointer :: VEGCLS + real, dimension(:), pointer :: SOILCLS + real, dimension(:), pointer :: SAND + real, dimension(:), pointer :: CLAY + real, dimension(:), pointer :: mw_POROS + real, dimension(:), pointer :: WANGWT + real, dimension(:), pointer :: WANGWP + real, dimension(:), pointer :: RGHHMIN + real, dimension(:), pointer :: RGHHMAX + real, dimension(:), pointer :: RGHWMAX + real, dimension(:), pointer :: RGHWMIN + real, dimension(:), pointer :: RGHNRH + real, dimension(:), pointer :: RGHNRV + real, dimension(:), pointer :: RGHPOLMIX + real, dimension(:), pointer :: OMEGA + real, dimension(:), pointer :: BH + real, dimension(:), pointer :: BV + real, dimension(:), pointer :: LEWT + ! export + real, dimension(:), pointer :: TB_H + real, dimension(:), pointer :: TB_V + + real, allocatable, dimension(:) :: SWE + real, allocatable, dimension(:) :: sfmc_mwRTM, tsoil_mwRTM + real, allocatable, dimension(:) :: Tair_not_used, elev_not_used + real, allocatable, dimension(:) :: Tb_v_tmp, TB_h_tmp + + + + integer :: N_catl + type(MAPL_LocStream) :: locstream + integer , save :: ens_id = 0 + + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) + VERIFY_(STATUS) + Iam=trim(COMP_NAME)//"::RUN" + + call MAPL_GetPointer(export, TB_H, 'TB_LAND_1410MHZ_40DEG_HPOL' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(export, TB_V, 'TB_LAND_1410MHZ_40DEG_VPOL' ,rc=status) + VERIFY_(STATUS) + + !if HISTORY doesnot ask for these varaibles, no calculation necessary + if (.not. associated(TB_H) .or. .not. associated(TB_V)) then + _RETURN(_SUCCESS) + endif + + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) + VERIFY_(status) + call MAPL_Get(MAPL, LocStream=locstream,rc=status) + VERIFY_(status) + call MAPL_LocStreamGet(locstream, NT_LOCAL=N_catl,rc=status) + VERIFY_(status) + +! Pointers to internals +!---------------------- + call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) + VERIFY_(status) + + call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL,SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, WANGWP , 'MWRTM_WANGWP' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, RGHHMIN , 'MWRTM_RGHHMIN' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, RGHHMAX , 'MWRTM_RGHHMAX' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, RGHWMIN , 'MWRTM_RGHWMIN' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, RGHWMAX , 'MWRTM_RGHWMAX' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, RGHNRH , 'MWRTM_RGHNRH' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, RGHNRV , 'MWRTM_RGHNRV' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) + VERIFY_(STATUS) + + allocate(mwRTM_param(N_catl)) + mwRTM_param(:)%sand = SAND(:) + mwRTM_param(:)%vegcls = nint(VEGCLS(:)) + mwRTM_param(:)%soilcls = nint(SOILCLS(:)) + mwRTM_param(:)%clay = CLAY(:) + mwRTM_param(:)%poros = mw_POROS(:) + mwRTM_param(:)%wang_wt = WANGWT(:) + mwRTM_param(:)%wang_wp = WANGWP(:) + mwRTM_param(:)%rgh_hmin = RGHHMIN(:) + mwRTM_param(:)%rgh_hmax = RGHHMAX(:) + mwRTM_param(:)%rgh_wmin = RGHWMIN(:) + mwRTM_param(:)%rgh_wmax = RGHWMAX(:) + mwRTM_param(:)%rgh_Nrh = RGHNRH(:) + mwRTM_param(:)%rgh_Nrv = RGHNRV(:) + mwRTM_param(:)%rgh_polmix= RGHPOLMIX(:) + mwRTM_param(:)%omega = OMEGA(:) + mwRTM_param(:)%bh = BH(:) + mwRTM_param(:)%bv = bv(:) + mwRTM_param(:)%lewt = LEWT(:) + + call MAPL_GetPointer(import, LAI, 'LAI' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(import, TP1, 'TP1' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(import, WCSF, 'WCSF' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(import, TPSURF, 'TPSURF' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(import, WESNN1, 'WESNN1' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(import, WESNN2, 'WESNN2' ,rc=status) + VERIFY_(status) + call MAPL_GetPointer(import, WESNN3, 'WESNN3' ,rc=status) + VERIFY_(STATUS) + - ! TO GET GOOD TB VALUES WE *MUST* HAVE "mwRTM_param" ! ! THIS NEEDS TO WORK EVEN IF WE DO NOT HAVE "mwRTM_param" ! @@ -2022,38 +2184,22 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) ! ! IT IS OK TO FILL TB WITH NO-DATA-VALUES IF "mwRTM_param" IS NOT AVAILABLE - - ! not sure where the loop through members should go -- maybe write subroutine - ! to operate on each member separately and create another subroutine that loops - ! through the members ? - - ! TO CALCULATE TB, THE FOLLOWING TWO SUBROUTINES NEED TO BE RUN (IN ORDER): ! call catch2mwRTM_vars() ! call mwRTM_get_Tb() - - - ! local parameters - - real, parameter :: freq = 1.41e9 ! microwave frequency [Hz] - - real, parameter :: inc_angle = 40. ! incidence angle [deg] - - logical, parameter :: incl_atm_terms = .false. ! no atmospheric correction, ie, get Tb at top-of-vegetation - ! convert Catchment model variables into inputs suitable for the mwRTM ! NOTE: input tp must be in degree Celsius! - + allocate(sfmc_mwRTM(N_catl), tsoil_mwRTM (N_catl)) call catch2mwRTM_vars( & - Nt, & ! intent(in), number of tiles (local?) - cat_param%vegcls, & ! intent(in), 'ITY' from imports (*cat_param* vegcls) --- not used anymore but keep for now - cat_param%poros, & ! intent(in), 'POROS' from imports (*cat_param* poros) - mwRTM_param%poros, & ! intent(in), 'MWRTM_POROS' = mw_poros - cat_diagS_avg%sfmc, & ! intent(in), 'WCSRF' need to import from "land" - cat_diagS_avg%tsurf, & ! intent(in), 'TPSURF' need to import from "land" --- not used anymore but keep for now - cat_diagS_avg%tp(1)-MAPL_TICE??, & ! intent(in), 'TP1' need to import from "land" -- units deg C !!! - sfmc_mwRTM, & ! intent(out), local variable - tsoil_mwRTM ) ! intent(out), local variable + N_catl, & ! intent(in), number of tiles (local?) + cat_param%vegcls, & ! intent(in), 'ITY' from imports (*cat_param* vegcls) --- not used anymore but keep for now + cat_param%poros, & ! intent(in), 'POROS' from imports (*cat_param* poros) + mwRTM_param%poros,& ! intent(in), 'MWRTM_POROS' = mw_poros + WCSF, & ! cat_diagS_avg%sfmc, & ! intent(in), 'WCSRF' need to import from "land" + TPSURF, & !cat_diagS_avg%tsurf, & ! intent(in), 'TPSURF' need to import from "land" --- not used anymore but keep for now + TP1-MAPL_TICE, & !cat_diagS_avg%tp(1)-MAPL_TICE??, & ! intent(in), 'TP1' need to import from "land" -- units deg C !!! + sfmc_mwRTM, & ! intent(out), local variable + tsoil_mwRTM ) ! intent(out), local variable ! calculate brightness temperatures ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] @@ -2061,28 +2207,46 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) ! IF NEEDED, USE DUMMY VARIABLES FOR tile_coord%elev AND Tair ALONG WITH AN IF STATEMENT AS FOLLOWS: + allocate(TB_h_tmp(N_catl), TB_v_tmp(N_catl)) + allocate(SWE(N_catl)) + SWE(:) = WESNN1(:) + WESNN2(:) + WESNN2(:) if (.not. incl_atm_terms) then - + allocate(Tair_Not_used(N_catl), elev_not_used(N_catl)) call mwRTM_get_Tb(& - Nt, freq, inc_angle, mwRTM_param, & ! intent(in) - tile_coord%elev, & ! intent(in), elevation of tile, ignore if not readily available, NOT NEEDED AS LONG AS "incl_atm_terms=.false." - veg_param_avg%lai, & ! intent(in) 'LAI' - sfmc_mwRTM, tsoil_mwRTM, & ! intent(in), output from catch2mwRTM_var() - SWE, & ! intent(in), 'SNOMASS' need to import from "land" - met_force_avg%Tair, & ! intent(in), 'TAIR' could be imported from MetForce GC, NOT NEEDED AS LONG AS "incl_atm_terms=.false." - incl_atm_terms, & ! intent(in) - Tb_h, Tb_v ) ! intent(out) --> 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' - + N_catl, freq, inc_angle, mwRTM_param, & ! intent(in) + elev_Not_used, & ! intent(in), NOT NEEDED AS LONG AS "incl_atm_terms=.false." + LAI, & ! intent(in), 'LAI' + sfmc_mwRTM, & ! intent(in), output from catch2mwRTM_var() + tsoil_mwRTM, & ! intent(in), output from catch2mwRTM_var() + SWE, & ! intent(in), 'SNOMASS' , sum of wesnn + Tair_Not_used, & ! intent(in), NOT NEEDED AS LONG AS "incl_atm_terms=.false." + incl_atm_terms, & ! intent(in), .false. + Tb_h_tmp, Tb_v_tmp ) ! intent(out) 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' + deallocate(Tair_Not_used, elev_not_used) else + _ASSERT(.false., "incl_atm_terms should be .false.") + end if + if (ens_id == 0) then + TB_V = 0. + TB_H = 0. + endif - ! ADD CALL TO LDAS_ERROR, STOP PROGRAM IF ENDING UP HERE - - end if - + TB_V(:) = TB_V(:) + Tb_v_tmp(:) + TB_H(:) = TB_H(:) + Tb_h_tmp(:) -end subroutine CALC_LAND_TB + if(ens_id == NUM_ENSEMBLE-1) then + TB_V(:) = TB_V(:)/NUM_ENSEMBLE + TB_H(:) = TB_H(:)/NUM_ENSEMBLE + ens_id = 0 + else + ens_id = ens_id + 1 + endif + + deallocate(SWE, Tb_h_tmp, Tb_v_tmp) + RETURN_(_SUCCESS) +end subroutine CALC_LAND_TB subroutine read_pert_rseed(seed_fname,pert_rseed_r8) use netcdf From 9cc6e63095c67d25b73074d9e23b30fb49e9bafd Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Thu, 14 May 2020 15:23:07 -0400 Subject: [PATCH 03/19] additional edits and cleanup towards Tb output from HISTORY --- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 5 +- .../GEOSens_GridComp/GEOS_EnsGridComp.F90 | 5 - .../GEOS_LandAssimGridComp.F90 | 152 +++++++++--------- 3 files changed, 78 insertions(+), 84 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index 4f00576b..f6d0ccd6 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -879,14 +879,15 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) if(assim) then - ! calculate L-band Tb and accumulate among ensemble - ! average when i == num_ensemble + ! calculate ensemble-average L-band Tb (add up and normalize after last member has been added) call ESMF_GridCompRun(gcs(LANDASSIM), importState=gex(igc), exportState=gex(LANDASSIM), clock=clock,phase=3, userRC=status) VERIFY_(status) endif endif ! Should this be moved to the beginning of the loop to avoid the pollution ? + ! THIS MUST BE MOVED AT LEAST TO BEFORE THE "ENSAVG/phase=3" CALL IF ENSEMBLE STATS OTHER THAN THE AVERAGE + ! ARE COMPUTED - reichle, 14 May 2020 ! ApplyPrognPert igc = LANDPERT(i) call MAPL_TimerOn(MAPL, gcnames(igc)) diff --git a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 index 8703eea4..e43a9692 100644 --- a/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSens_GridComp/GEOS_EnsGridComp.F90 @@ -98,11 +98,6 @@ subroutine SetServices(gc, rc) ) VERIFY_(status) - ! RRTBHISTORY - ! - ! add new phase that collects L-band Tb_h and Tb_v - - call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_FINALIZE, & diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 2c8b8fce..d3b6690a 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -66,6 +66,8 @@ module GEOS_LandAssimGridCompMod use, intrinsic :: ieee_arithmetic + integer :: collect_tb_counter + implicit none include 'mpif.h' @@ -174,8 +176,7 @@ subroutine SetServices ( GC, RC ) ) VERIFY_(status) - ! RRTBHISTORY - !phase 3: calculation of L-band Tb_h and Tb_v for each ensemble membe + !phase 3: calculation of L-band Tb_h and Tb_v for each ensemble member call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & @@ -480,8 +481,6 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) - ! RRTBHISTORY - ! ! Exports for brightness temperature call MAPL_AddExportSpec(GC ,& @@ -502,8 +501,7 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) - ! Export for incr - ! + ! Exports for incr call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_canopy_temperature_saturated_zone' ,& @@ -1008,6 +1006,8 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) VERIFY_(STATUS) + collect_tb_counter = 0 + call init_log( myid, numprocs, master_proc ) ! Get current time @@ -1385,13 +1385,13 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) if (need_mwRTM_param) then call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) VERIFY_(STATUS) @@ -1411,13 +1411,13 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) VERIFY_(STATUS) allocate(mwRTM_param(N_catl)) @@ -2013,14 +2013,12 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) end subroutine UPDATE_ASSIM -! RRTBHISTORY -! -! new subroutine to calculate Tb +! subroutine to calculate Tb subroutine CALC_LAND_TB(gc, import, export, clock, rc) type(ESMF_GridComp), intent(inout) :: gc ! Gridded component type(ESMF_State), intent(inout) :: import ! Import state - ! this import is from land grid come + ! this import is from land grid component type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code @@ -2037,13 +2035,13 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) type(ESMF_State) :: INTERNAL type(mwRTM_param_type),dimension(:),allocatable :: mwRTM_param - real, dimension(:),pointer :: LAI - real, dimension(:),pointer :: TP1 - real, dimension(:),pointer :: TPSURF - real, dimension(:),pointer :: WCSF - real, dimension(:),pointer :: WESNN1 - real, dimension(:),pointer :: WESNN2 - real, dimension(:),pointer :: WESNN3 + real, dimension(:), pointer :: LAI + real, dimension(:), pointer :: TP1 + real, dimension(:), pointer :: TPSURF + real, dimension(:), pointer :: WCSF + real, dimension(:), pointer :: WESNN1 + real, dimension(:), pointer :: WESNN2 + real, dimension(:), pointer :: WESNN3 real, dimension(:), pointer :: VEGCLS real, dimension(:), pointer :: SOILCLS @@ -2064,31 +2062,31 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) real, dimension(:), pointer :: BV real, dimension(:), pointer :: LEWT ! export - real, dimension(:), pointer :: TB_H - real, dimension(:), pointer :: TB_V + real, dimension(:), pointer :: TB_H_enavg + real, dimension(:), pointer :: TB_V_enavg real, allocatable, dimension(:) :: SWE real, allocatable, dimension(:) :: sfmc_mwRTM, tsoil_mwRTM - real, allocatable, dimension(:) :: Tair_not_used, elev_not_used + real, allocatable, dimension(:) :: dummy_real real, allocatable, dimension(:) :: Tb_v_tmp, TB_h_tmp integer :: N_catl type(MAPL_LocStream) :: locstream - integer , save :: ens_id = 0 + !integer , save :: ens_id = 0 call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) VERIFY_(STATUS) Iam=trim(COMP_NAME)//"::RUN" - call MAPL_GetPointer(export, TB_H, 'TB_LAND_1410MHZ_40DEG_HPOL' ,rc=status) + call MAPL_GetPointer(export, TB_H_enavg, 'TB_LAND_1410MHZ_40DEG_HPOL' ,rc=status) VERIFY_(status) - call MAPL_GetPointer(export, TB_V, 'TB_LAND_1410MHZ_40DEG_VPOL' ,rc=status) + call MAPL_GetPointer(export, TB_V_enavg, 'TB_LAND_1410MHZ_40DEG_VPOL' ,rc=status) VERIFY_(STATUS) - !if HISTORY doesnot ask for these varaibles, no calculation necessary - if (.not. associated(TB_H) .or. .not. associated(TB_V)) then + !if HISTORY does not ask for these varaibles, no calculation necessary + if (.not. associated(TB_H_enavg) .or. .not. associated(TB_V_enavg)) then _RETURN(_SUCCESS) endif @@ -2104,6 +2102,8 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) VERIFY_(status) + ! RRTBHISTORY - do we need to fill "mwRTM_param" this here and in RUN? Can this be moved to Initialize? + call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL,SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) @@ -2112,7 +2112,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) VERIFY_(STATUS) @@ -2132,13 +2132,13 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) + call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) VERIFY_(STATUS) allocate(mwRTM_param(N_catl)) @@ -2161,11 +2161,11 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) mwRTM_param(:)%bv = bv(:) mwRTM_param(:)%lewt = LEWT(:) - call MAPL_GetPointer(import, LAI, 'LAI' ,rc=status) + call MAPL_GetPointer(import, LAI, 'LAI' ,rc=status) VERIFY_(status) - call MAPL_GetPointer(import, TP1, 'TP1' ,rc=status) + call MAPL_GetPointer(import, TP1, 'TP1' ,rc=status) VERIFY_(status) - call MAPL_GetPointer(import, WCSF, 'WCSF' ,rc=status) + call MAPL_GetPointer(import, WCSF, 'WCSF' ,rc=status) VERIFY_(status) call MAPL_GetPointer(import, TPSURF, 'TPSURF' ,rc=status) VERIFY_(status) @@ -2184,67 +2184,65 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) ! ! IT IS OK TO FILL TB WITH NO-DATA-VALUES IF "mwRTM_param" IS NOT AVAILABLE - ! TO CALCULATE TB, THE FOLLOWING TWO SUBROUTINES NEED TO BE RUN (IN ORDER): - ! call catch2mwRTM_vars() - ! call mwRTM_get_Tb() ! convert Catchment model variables into inputs suitable for the mwRTM ! NOTE: input tp must be in degree Celsius! allocate(sfmc_mwRTM(N_catl), tsoil_mwRTM (N_catl)) call catch2mwRTM_vars( & - N_catl, & ! intent(in), number of tiles (local?) + N_catl, & cat_param%vegcls, & ! intent(in), 'ITY' from imports (*cat_param* vegcls) --- not used anymore but keep for now cat_param%poros, & ! intent(in), 'POROS' from imports (*cat_param* poros) mwRTM_param%poros,& ! intent(in), 'MWRTM_POROS' = mw_poros - WCSF, & ! cat_diagS_avg%sfmc, & ! intent(in), 'WCSRF' need to import from "land" - TPSURF, & !cat_diagS_avg%tsurf, & ! intent(in), 'TPSURF' need to import from "land" --- not used anymore but keep for now - TP1-MAPL_TICE, & !cat_diagS_avg%tp(1)-MAPL_TICE??, & ! intent(in), 'TP1' need to import from "land" -- units deg C !!! - sfmc_mwRTM, & ! intent(out), local variable - tsoil_mwRTM ) ! intent(out), local variable - + WCSF, & + TPSURF, & + TP1-MAPL_TICE, & ! units deg C !!! + sfmc_mwRTM, & ! intent(out), local variable + tsoil_mwRTM ) ! intent(out), local variable + ! calculate brightness temperatures ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] ! but without Pellarin atmospheric corrections) - + ! IF NEEDED, USE DUMMY VARIABLES FOR tile_coord%elev AND Tair ALONG WITH AN IF STATEMENT AS FOLLOWS: - + allocate(TB_h_tmp(N_catl), TB_v_tmp(N_catl)) allocate(SWE(N_catl)) - SWE(:) = WESNN1(:) + WESNN2(:) + WESNN2(:) + SWE(:) = WESNN1(:) + WESNN2(:) + WESNN2(:) ! WHY NOT IMPORT SNOMASS? if (.not. incl_atm_terms) then - allocate(Tair_Not_used(N_catl), elev_not_used(N_catl)) - call mwRTM_get_Tb(& - N_catl, freq, inc_angle, mwRTM_param, & ! intent(in) - elev_Not_used, & ! intent(in), NOT NEEDED AS LONG AS "incl_atm_terms=.false." - LAI, & ! intent(in), 'LAI' - sfmc_mwRTM, & ! intent(in), output from catch2mwRTM_var() - tsoil_mwRTM, & ! intent(in), output from catch2mwRTM_var() - SWE, & ! intent(in), 'SNOMASS' , sum of wesnn - Tair_Not_used, & ! intent(in), NOT NEEDED AS LONG AS "incl_atm_terms=.false." - incl_atm_terms, & ! intent(in), .false. - Tb_h_tmp, Tb_v_tmp ) ! intent(out) 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' + allocate(dummy_real(N_catl)) ! DO WE EVEN NEED TO ALLOCATE? + call mwRTM_get_Tb( & + N_catl, freq, inc_angle, mwRTM_param, & + dummy_real, & ! intent(in), "elev", not used as long as "incl_atm_terms=.false." + LAI, & + sfmc_mwRTM, & + tsoil_mwRTM, & + SWE, & + dummy_real, & ! intent(in), "Tair", not used as long as "incl_atm_terms=.false." + incl_atm_terms, & + Tb_h_tmp, Tb_v_tmp ) ! intent(out) 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' deallocate(Tair_Not_used, elev_not_used) else _ASSERT(.false., "incl_atm_terms should be .false.") end if - - if (ens_id == 0) then - TB_V = 0. - TB_H = 0. + + if (collect_tb_counter == 0) then + TB_V_enavg = 0. + TB_H_enavg = 0. endif - TB_V(:) = TB_V(:) + Tb_v_tmp(:) - TB_H(:) = TB_H(:) + Tb_h_tmp(:) + ! This counter is relative to ens_id + collect_tb_counter = collect_tb_counter + 1 + + TB_V_enavg(:) = TB_V_enavg(:) + Tb_v_tmp(:) + TB_H_enavg(:) = TB_H_enavg(:) + Tb_h_tmp(:) - if(ens_id == NUM_ENSEMBLE-1) then - TB_V(:) = TB_V(:)/NUM_ENSEMBLE - TB_H(:) = TB_H(:)/NUM_ENSEMBLE - ens_id = 0 - else - ens_id = ens_id + 1 + if (collect_tb_counter == NUM_ENSEMBLE) then + collect_tb_counter = 0 + TB_V_enavg(:) = TB_V_enavg(:)/NUM_ENSEMBLE + TB_H_enavg(:) = TB_H_enavg(:)/NUM_ENSEMBLE endif - + deallocate(SWE, Tb_h_tmp, Tb_v_tmp) - + RETURN_(_SUCCESS) end subroutine CALC_LAND_TB From 86974e06ea2031f0c07c9fe7d15c3c3d58805922 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 15 May 2020 08:45:52 -0400 Subject: [PATCH 04/19] further polishing. Change LAND_ASSIM to integer --- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 19 +- .../GEOS_LandAssimGridComp.F90 | 832 +++++++++--------- 2 files changed, 402 insertions(+), 449 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index f6d0ccd6..488e1d41 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -58,7 +58,7 @@ module GEOS_LdasGridCompMod integer,allocatable :: LANDPERT(:) integer :: ENSAVG, LANDASSIM integer :: NUM_ENSEMBLE - logical :: assim + integer :: land_assim contains !BOP @@ -86,7 +86,6 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: id_string,childname, fmt_str - character(len=ESMF_MAXSTR) :: LAND_ASSIM integer :: ens_id_width ! Local variables type(T_TILECOORD_STATE), pointer :: tcinternal @@ -142,11 +141,8 @@ subroutine SetServices(gc, rc) call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, LAND_ASSIM, Label="LAND_ASSIM:", DEFAULT="NO", RC=STATUS) + call MAPL_GetResource ( MAPL, land_assim, Label="LAND_ASSIM:", DEFAULT= 0, RC=STATUS) VERIFY_(STATUS) - LAND_ASSIM = ESMF_UtilStringUpperCase(LAND_ASSIM, rc=STATUS) - VERIFY_(STATUS) - assim = (LAND_ASSIM /= 'NO') allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) allocate(DATAATM(1)) @@ -193,7 +189,7 @@ subroutine SetServices(gc, rc) ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) VERIFY_(status) - if(assim) then + if(land_assim > 0 ) then LANDASSIM = MAPL_AddChild(gc, name='LANDASSIM', ss=LandAssimSetServices, rc=status) VERIFY_(status) endif @@ -264,7 +260,7 @@ subroutine SetServices(gc, rc) VERIFY_(status) enddo - if(assim) then + if(land_assim > 0) then call MAPL_AddConnectivity( & gc, & SHORT_NAME = ['POROS ', 'COND ','PSIS ','BEE ','WPWET ','GNU ','VGWMAX', & @@ -418,7 +414,6 @@ subroutine Initialize(gc, import, export, clock, rc) call esmf2ldas(CurrentTime, start_time, rc=status) VERIFY_(status) - call MAPL_GetResource(MAPL,LDAS_logit,'LDAS_logit:',default = "NO",rc = status) VERIFY_(status) @@ -693,7 +688,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) enddo - if (assim) then + if (land_assim > 0) then call MAPL_GetObjectFromGC(gcs(LANDASSIM), CHILD_MAPL, rc=status) VERIFY_(status) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) @@ -878,7 +873,7 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=2, userRC=status) VERIFY_(status) - if(assim) then + if(land_assim > 0) then ! calculate ensemble-average L-band Tb (add up and normalize after last member has been added) call ESMF_GridCompRun(gcs(LANDASSIM), importState=gex(igc), exportState=gex(LANDASSIM), clock=clock,phase=3, userRC=status) VERIFY_(status) @@ -898,7 +893,7 @@ subroutine Run(gc, import, export, clock, rc) enddo !run land assim - if (assim) then + if (land_assim == 1) then igc = LANDASSIM call MAPL_TimerOn(MAPL, gcnames(igc)) !import state is the export from ens_GridComp, assimilation run diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index d3b6690a..7351f1ef 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -31,7 +31,7 @@ module GEOS_LandAssimGridCompMod use LDAS_ensdrv_mpi, only: MPI_obs_param_type use LDAS_DateTimeMod,ONLY: date_time_type - use LDAS_ensdrv_Globals, only: logunit + use LDAS_ensdrv_Globals, only: logunit, nodata_generic use LDAS_ConvertMod, ONLY: esmf2ldas use LDAS_DriverTypes, ONLY: & @@ -45,7 +45,7 @@ module GEOS_LandAssimGridCompMod use lsm_routines, only: DZGT use GEOS_EnsGridCompMod, only: cat_progn=>catch_progn use GEOS_EnsGridCompMod, only: cat_param=>catch_param - use mwRTM_types, only: mwRTM_param_type + use mwRTM_types, only: mwRTM_param_type, mwRTM_param_nodata_check use catch_bias_types, only: obs_bias_type use catch_bias_types, only: cat_bias_param_type use catch_types, only: cat_progn_type @@ -66,7 +66,6 @@ module GEOS_LandAssimGridCompMod use, intrinsic :: ieee_arithmetic - integer :: collect_tb_counter implicit none @@ -83,6 +82,7 @@ module GEOS_LandAssimGridCompMod integer, parameter :: NUM_SUBTILES = 4 integer :: NUM_ENSEMBLE integer :: FIRST_ENS_ID +integer :: collect_tb_counter type(met_force_type), allocatable :: mfPert_ensavg(:) @@ -108,6 +108,8 @@ module GEOS_LandAssimGridCompMod type(tile_coord_type), dimension(:), pointer :: tile_coord_rf => null() integer, allocatable :: Pert_rseed(:,:) real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) +type(mwRTM_param_type),dimension(:),allocatable :: mwRTM_param +logical :: all_nodata ! no data for mwRTM_param contains @@ -143,11 +145,11 @@ subroutine SetServices ( GC, RC ) Iam='SetServices' call ESMF_GridCompGet ( GC, NAME=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) Iam=trim(COMP_NAME)//trim(Iam) call MAPL_GetObjectFromGC(gc, MAPL, rc=status) - VERIFY_(status) + _VERIFY(status) ! Register services for this component call MAPL_GridCompSetEntryPoint( & @@ -156,7 +158,7 @@ subroutine SetServices ( GC, RC ) Initialize, & rc=status & ) - VERIFY_(status) + _VERIFY(status) !phase 1: assimilation run call MAPL_GridCompSetEntryPoint( & @@ -165,7 +167,7 @@ subroutine SetServices ( GC, RC ) RUN, & rc=status & ) - VERIFY_(status) + _VERIFY(status) !phase 2: feed back to change catch_progn call MAPL_GridCompSetEntryPoint( & @@ -174,7 +176,7 @@ subroutine SetServices ( GC, RC ) UPDATE_ASSIM, & rc=status & ) - VERIFY_(status) + _VERIFY(status) !phase 3: calculation of L-band Tb_h and Tb_v for each ensemble member call MAPL_GridCompSetEntryPoint( & @@ -183,7 +185,7 @@ subroutine SetServices ( GC, RC ) CALC_LAND_TB, & rc=status & ) - VERIFY_(status) + _VERIFY(status) call MAPL_GridCompSetEntryPoint( & gc, & @@ -191,7 +193,7 @@ subroutine SetServices ( GC, RC ) Finalize, & rc=status & ) - VERIFY_(status) + _VERIFY(status) @@ -210,7 +212,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'sfc_sat_hydraulic_conduct' ,& UNITS = 'm s-1' ,& @@ -218,7 +220,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'saturated_matric_potential',& @@ -227,7 +229,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'clapp_hornberger_b' ,& @@ -236,7 +238,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'wetness_at_wilting_point' ,& UNITS = '1' ,& @@ -244,7 +246,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& @@ -254,7 +256,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'max_rootzone_water_content',& @@ -263,7 +265,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'topo_baseflow_param_1' ,& @@ -272,7 +274,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'topo_baseflow_param_2' ,& @@ -281,7 +283,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'topo_baseflow_param_3' ,& @@ -290,7 +292,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& @@ -300,7 +302,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'max_water_content' ,& @@ -309,7 +311,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'wetness_param_1' ,& @@ -318,7 +320,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'wetness_param_2' ,& @@ -327,7 +329,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'wetness_param_3' ,& @@ -336,7 +338,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'shape_param_1' ,& @@ -345,7 +347,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'shape_param_2' ,& @@ -354,7 +356,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'shape_param_3' ,& @@ -363,7 +365,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'shape_param_4' ,& @@ -372,7 +374,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'min_theta_param_1' ,& @@ -381,7 +383,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'min_theta_param_2' ,& UNITS = 'm+2 kg-1' ,& @@ -389,7 +391,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'min_theta_param_3' ,& @@ -398,7 +400,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'min_theta_param_4' ,& @@ -407,7 +409,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'water_transfer_param_1' ,& @@ -416,7 +418,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'water_transfer_param_2' ,& UNITS = '1' ,& @@ -424,7 +426,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'water_transfer_param_3' ,& @@ -433,7 +435,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'water_transfer_param_4' ,& @@ -442,7 +444,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'water_transfer_param_5' ,& @@ -451,7 +453,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& LONG_NAME = 'water_transfer_param_6' ,& @@ -460,7 +462,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'ITY' ,& @@ -469,7 +471,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'Z2CH' ,& @@ -478,7 +480,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) ! Exports for brightness temperature @@ -490,7 +492,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'brightness_temperature_land_1410MHz_40deg_Vpol' ,& @@ -499,7 +501,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) ! Exports for incr @@ -511,7 +513,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_canopy_temperature_transition_zone' ,& @@ -521,7 +523,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_canopy_temperature_wilting_zone' ,& UNITS = 'K' ,& @@ -530,7 +532,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone' ,& @@ -540,7 +542,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_canopy_specific_humidity_transition_zone' ,& @@ -550,7 +552,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone' ,& UNITS = 'kg kg-1' ,& @@ -559,7 +561,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_interception_reservoir_capac',& @@ -569,7 +571,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_catchment_deficit' ,& @@ -579,7 +581,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_root_zone_excess' ,& @@ -589,7 +591,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& @@ -600,7 +602,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_soil_heat_content_layer_1' ,& @@ -610,7 +612,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_soil_heat_content_layer_2' ,& @@ -620,7 +622,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_soil_heat_content_layer_3' ,& @@ -630,7 +632,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_soil_heat_content_layer_4' ,& @@ -640,7 +642,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_soil_heat_content_layer_5' ,& UNITS = 'J m-2' ,& @@ -649,7 +651,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_soil_heat_content_layer_6' ,& @@ -659,7 +661,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_snow_mass_layer_1' ,& @@ -669,7 +671,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_snow_mass_layer_2' ,& @@ -679,7 +681,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_snow_mass_layer_3' ,& @@ -689,7 +691,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_heat_content_snow_layer_1' ,& @@ -699,7 +701,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_heat_content_snow_layer_2' ,& @@ -709,7 +711,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_heat_content_snow_layer_3' ,& @@ -719,7 +721,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_snow_depth_layer_1' ,& @@ -729,7 +731,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_snow_depth_layer_2' ,& @@ -739,7 +741,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'increment_snow_depth_layer_3' ,& UNITS = 'm' ,& @@ -748,7 +750,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) ! ! INTERNAL STATE @@ -760,7 +762,7 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -769,7 +771,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_SOILCLS' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -778,7 +780,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_SAND' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -787,7 +789,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_CLAY' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -796,7 +798,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_POROS' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -805,7 +807,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_WANGWT' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -814,7 +816,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_WANGWP' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -823,7 +825,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHHMIN' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -832,7 +834,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHHMAX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -841,7 +843,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHWMIN' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF , & + DEFAULT = nodata_generic , & RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -850,7 +852,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHWMAX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -859,7 +861,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHNRH' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -868,7 +870,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHNRV' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -877,7 +879,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHPOLMIX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -886,7 +888,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_OMEGA' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -895,7 +897,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_BH' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -904,7 +906,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_BV' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -913,16 +915,16 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_LEWT' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = MAPL_UNDEF ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_TimerAdd(GC, name="Initialize" ,RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_TimerAdd(GC, name="RUN" ,RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_GenericSetServices ( GC, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) RETURN_(ESMF_SUCCESS) @@ -981,45 +983,47 @@ subroutine Initialize(gc, import, export, clock, rc) character(len=14) :: datestamp character(len=4) :: id_string integer :: nymd, nhms + + !! from LDASsa ! Begin... ! Get component's name and setup traceback handle call ESMF_GridCompget(gc, name=comp_name, rc=status) - VERIFY_(status) + _VERIFY(status) Iam = trim(comp_name) // "::Initialize" ! Get MAPL obj call MAPL_GetObjectFromGC(gc, MAPL, rc=status) - VERIFY_(status) + _VERIFY(status) ! Turn timers on call MAPL_TimerOn(MAPL, "TOTAL") call MAPL_TimerOn(MAPL, "Initialize") + + collect_tb_counter = 0 call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) - VERIFY_(STATUS) - - collect_tb_counter = 0 + _VERIFY(STATUS) call init_log( myid, numprocs, master_proc ) ! Get current time call ESMF_ClockGet(clock, currTime=CurrentTime, rc=status) - VERIFY_(status) + _VERIFY(status) call esmf2ldas(CurrentTime, start_time, rc=status) - VERIFY_(status) + _VERIFY(status) call ESMF_ClockGet(clock, timeStep=ModelTimeStep,rc=status) - VERIFY_(status) + _VERIFY(status) call ESMF_TimeIntervalGet(ModelTimeStep, s=model_dtstep,rc=status) - VERIFY_(status) + _VERIFY(status) ! Create alarm for Land assimilation ! -create-nonsticky-alarm- @@ -1031,10 +1035,10 @@ subroutine Initialize(gc, import, export, clock, rc) default=10800, & rc=status & ) - VERIFY_(status) + _VERIFY(status) call ESMF_TimeIntervalSet(LandAssim_DT, s=LandAssimDtStep, rc=status) - VERIFY_(status) + _VERIFY(status) LandAssimAlarm = ESMF_AlarmCreate( & clock, & @@ -1045,17 +1049,17 @@ subroutine Initialize(gc, import, export, clock, rc) sticky=.false., & rc=status & ) - VERIFY_(status) + _VERIFY(status) call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) - VERIFY_(status) + _VERIFY(status) tcinternal =>tcwrap%ptr tile_coord_l =>tcinternal%tile_coord ! Get number of land tiles call MAPL_Get(MAPL, LocStream=locstream,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_LocStreamGet(locstream, NT_LOCAL=land_nt_local,rc=status) - VERIFY_(status) + _VERIFY(status) allocate(Pert_rseed(NRANDSEED, NUM_ENSEMBLE), source = 0) allocate(Pert_rseed_r8(NRANDSEED, NUM_ENSEMBLE), source = 0.0d0) @@ -1063,9 +1067,9 @@ subroutine Initialize(gc, import, export, clock, rc) if (master_proc) then call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_RESTART_FILE:", DEFAULT="../intput/restart/landassim_obspertrseed%s_rst", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_DateStampGet( clock, datestamp, rc=status) - VERIFY_(STATUS) + _VERIFY(STATUS) read(datestamp(1:8),*) nymd read(datestamp(10:13),*) nhms nhms = nhms*100 @@ -1152,7 +1156,7 @@ subroutine Initialize(gc, import, export, clock, rc) N_obsbias_max & ) call MAPL_GetResource ( MAPL, GridName, Label="GEOSldas.GRIDNAME:", DEFAULT="EASE", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) if (index(GridName,"-CF") /=0) out_smapL4SMaup = .false. ! no out_smap for now if it is cs frid endif @@ -1176,7 +1180,7 @@ subroutine Initialize(gc, import, export, clock, rc) if (master_proc) call echo_clsm_ensupd_glob_param(logunit) call MAPL_GenericInitialize(gc, import, export, clock, rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_TimerOff(MAPL, "Initialize") call MAPL_TimerOff(MAPL, "TOTAL") @@ -1216,7 +1220,6 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), pointer :: tile_coord_l(:)=>null() type(T_TILECOORD_STATE), pointer :: tcinternal - type(mwRTM_param_type),dimension(:),allocatable :: mwRTM_param type(ESMF_State) :: INTERNAL type(date_time_type) :: start_time @@ -1244,28 +1247,6 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) logical :: fresh_incr integer :: N_obsf,N_obsl integer :: secs_in_day -! ----------------------------------------------------- -! INTERNAL Pointers -! ----------------------------------------------------- - - real, dimension(:), pointer :: VEGCLS - real, dimension(:), pointer :: SOILCLS - real, dimension(:), pointer :: SAND - real, dimension(:), pointer :: CLAY - real, dimension(:), pointer :: mw_POROS - real, dimension(:), pointer :: WANGWT - real, dimension(:), pointer :: WANGWP - real, dimension(:), pointer :: RGHHMIN - real, dimension(:), pointer :: RGHHMAX - real, dimension(:), pointer :: RGHWMAX - real, dimension(:), pointer :: RGHWMIN - real, dimension(:), pointer :: RGHNRH - real, dimension(:), pointer :: RGHNRV - real, dimension(:), pointer :: RGHPOLMIX - real, dimension(:), pointer :: OMEGA - real, dimension(:), pointer :: BH - real, dimension(:), pointer :: BV - real, dimension(:), pointer :: LEWT !! import ensemble forcing @@ -1339,106 +1320,52 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) Iam=trim(COMP_NAME)//"::RUN" call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) ! Start timers ! ------------ call MAPL_TimerOn(MAPL,"TOTAL") call MAPL_TimerOn(MAPL,"RUN") call ESMF_ClockGetAlarm(clock, 'LandAssim', LandAssimAlarm, rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) ! Get component's internal variable call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) - VERIFY_(status) + _VERIFY(status) tcinternal => tcwrap%ptr tile_coord_l => tcwrap%ptr%tile_coord call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) - VERIFY_(status) + _VERIFY(status) ! Get current time call ESMF_ClockGet(clock, timeStep=ModelTimeStep,rc=status) - VERIFY_(status) + _VERIFY(status) call ESMF_ClockGet(clock, currTime=ModelTimeCur, rc=status) - VERIFY_(status) + _VERIFY(status) call esmf2ldas(ModelTimeCur+ModelTimeStep, date_time_new, rc=status) - VERIFY_(status) + _VERIFY(status) call esmf2ldas(ModelTimeCur, start_time, rc=status) - VERIFY_(status) + _VERIFY(status) ! Get number of land tiles call MAPL_Get(MAPL, LocStream=locstream,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_LocStreamGet(locstream, NT_LOCAL=N_catl,rc=status) - VERIFY_(status) + _VERIFY(status) ! Pointers to internals !---------------------- if (need_mwRTM_param) then - call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, WANGWP , 'MWRTM_WANGWP' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHHMIN , 'MWRTM_RGHHMIN' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHHMAX , 'MWRTM_RGHHMAX' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHWMIN , 'MWRTM_RGHWMIN' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHWMAX , 'MWRTM_RGHWMAX' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHNRH , 'MWRTM_RGHNRH' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHNRV , 'MWRTM_RGHNRV' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) - VERIFY_(STATUS) - - allocate(mwRTM_param(N_catl)) - mwRTM_param(:)%sand = SAND(:) - mwRTM_param(:)%vegcls = nint(VEGCLS(:)) - mwRTM_param(:)%soilcls = nint(SOILCLS(:)) - mwRTM_param(:)%clay = CLAY(:) - mwRTM_param(:)%poros = mw_POROS(:) - mwRTM_param(:)%wang_wt = WANGWT(:) - mwRTM_param(:)%wang_wp = WANGWP(:) - mwRTM_param(:)%rgh_hmin = RGHHMIN(:) - mwRTM_param(:)%rgh_hmax = RGHHMAX(:) - mwRTM_param(:)%rgh_wmin = RGHWMIN(:) - mwRTM_param(:)%rgh_wmax = RGHWMAX(:) - mwRTM_param(:)%rgh_Nrh = RGHNRH(:) - mwRTM_param(:)%rgh_Nrv = RGHNRV(:) - mwRTM_param(:)%rgh_polmix= RGHPOLMIX(:) - mwRTM_param(:)%omega = OMEGA(:) - mwRTM_param(:)%bh = BH(:) - mwRTM_param(:)%bv = bv(:) - mwRTM_param(:)%lewt = LEWT(:) + call get_mwrtm_param(INTERNAL, rc=STATUS) + _VERIFY(STATUS) endif if (firsttime) then @@ -1458,10 +1385,10 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) if (master_proc) then Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) fname_tpl = trim(fname_tpl) //".%y4%m2%d2_%h2%n2z.nc4" call MAPL_DateStampGet( clock, datestamp, rc=status) - VERIFY_(STATUS) + _VERIFY(STATUS) read(datestamp(1:8),*) nymd read(datestamp(10:13),*) nhms nhms = nhms*100 @@ -1469,7 +1396,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) write(id_string,'(I4.4)') ens + FIRST_ENS_ID seed_fname = "" call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) - VERIFY_(STATUS) + _VERIFY(STATUS) call write_pert_rseed(trim(seed_fname), Pert_rseed_r8(:,ens+1)) enddo endif @@ -1487,92 +1414,92 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) !! get import from ens to get ensemble average forcing call MAPL_GetPointer(import, TA_enavg, 'TA', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, QA_enavg, 'QA', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, PS_enavg, 'PS', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, UU_enavg, 'UU', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, PCU_enavg, 'PCU', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, PLS_enavg, 'PLS', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, SNO_enavg, 'SNO', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, DRPAR_enavg, 'DRPAR', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, DFPAR_enavg, 'DFPAR', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, DRNIR_enavg, 'DRNIR', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, DFNIR_enavg, 'DFNIR', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, DRUVR_enavg, 'DRUVR', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, DFUVR_enavg, 'DFUVR', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, LWDNSRF_enavg, 'LWDNSRF', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, DZ_enavg, 'DZ', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, SWLAND, 'SWLAND', rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, LAI, 'LAI', rc=status) - VERIFY_(status) + _VERIFY(status) ! ! export for incr ! call MAPL_GetPointer(export, TC1_incr, 'TCFSAT_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, TC2_incr, 'TCFTRN_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, TC4_incr, 'TCFWLT_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, QC1_incr, 'QCFSAT_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, QC2_incr, 'QCFTRN_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, QC4_incr, 'QCFWLT_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, CAPAC_incr, 'CAPAC_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, CATDEF_incr, 'CATDEF_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, RZEXC_incr, 'RZEXC_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, SRFEXC_incr, 'SRFEXC_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT1_incr, 'GHTCNT1_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT2_incr, 'GHTCNT2_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT3_incr, 'GHTCNT3_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT4_incr, 'GHTCNT4_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT5_incr, 'GHTCNT5_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT6_incr, 'GHTCNT6_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, WESNN1_incr, 'WESNN1_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, WESNN2_incr, 'WESNN2_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, WESNN3_incr, 'WESNN3_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, HTSNNN1_incr, 'HTSNNN1_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, HTSNNN2_incr, 'HTSNNN2_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, HTSNNN3_incr, 'HTSNNN3_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, SNDZN1_incr, 'SNDZN1_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, SNDZN2_incr, 'SNDZN2_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, SNDZN3_incr, 'SNDZN3_INCR' ,rc=status) - VERIFY_(status) + _VERIFY(status) allocate(met_force(N_catl)) met_force(:)%Tair = TA_enavg(:) @@ -1614,10 +1541,10 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) if (firsttime) then firsttime = .false. call MAPL_LocStreamGet(LOCSTREAM, TILEGRID=TILEGRID, RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_TileMaskGet(tilegrid, mask, rc=status) - VERIFY_(STATUS) + _VERIFY(STATUS) allocate(metTair(N_catf),metTair_l(N_catl)) allocate(ids(N_catf)) @@ -1639,85 +1566,85 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) endif unit = GETFILE( "landassim_force_inputs.bin", form="unformatted", RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) ! Inputs - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Tair, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Qair, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Psurf, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf_c, mask=mask, rc=status); VERIFY_(STATUS) - - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Snowf, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%LWdown, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWdown, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWnet, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdrct,mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdffs, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%wind, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%RefH, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Tair, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Qair, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Psurf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf_c, mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Snowf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%LWdown, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWdown, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWnet, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdrct,mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdffs, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%wind, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%RefH, mask=mask, rc=status); _VERIFY(STATUS) unit = GETFILE( "landassim_catprogn_inputs.bin", form="unformatted", RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) ens_id = 1 - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc1, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc2, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc4, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc1, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc2, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc4, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa1, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa2, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa4, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa1, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa2, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa4, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%capac, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%catdef, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%rzexc, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%srfexc, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%capac, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%catdef, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%rzexc, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%srfexc, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(1), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(2), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(3), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(4), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(5), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(6), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(3), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(4), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(5), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(6), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(1), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(2), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(3), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(3), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(1), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(2), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(3), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(3), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(1), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(2), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(3), mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(3), mask=mask, rc=status); _VERIFY(STATUS) unit = GETFILE( "landassim_mwrtm_inputs.bin", form="unformatted", RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%vegcls), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%soilcls), mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%sand, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%clay, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%poros, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wt, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wp, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmin, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmax, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmin, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmax, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrh, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrv, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_polmix,mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%omega, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bh, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bv, mask=mask, rc=status); VERIFY_(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%lewt, mask=mask, rc=status); VERIFY_(STATUS) + call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%vegcls), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%soilcls), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%sand, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%clay, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%poros, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wt, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wp, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmin, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmax, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmin, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmax, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrh, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrv, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_polmix,mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%omega, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bh, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bv, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%lewt, mask=mask, rc=status); _VERIFY(STATUS) !unit = GETFILE( "landassim_catparam_inputs.bin", form="unformatted", RC=STATUS ) - !VERIFY_(STATUS) + !_VERIFY(STATUS) endif @@ -1915,60 +1842,60 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) !BOP call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) Iam=trim(COMP_NAME)//"::RUN" call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call ESMF_ClockGetAlarm(clock, 'LandAssim', LandAssimAlarm, rc=status) - VERIFY_(status) + _VERIFY(status) if ( .not. ESMF_AlarmIsRinging(LandAssimAlarm)) then RETURN_(ESMF_SUCCESS) endif call MAPL_GetPointer(export, TC, 'TC' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, QC, 'QC' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, CAPAC, 'CAPAC' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, CATDEF, 'CATDEF' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, RZEXC, 'RZEXC' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, SRFEXC, 'SRFEXC' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT1, 'GHTCNT1' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT2, 'GHTCNT2' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT3, 'GHTCNT3' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT4, 'GHTCNT4' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT5, 'GHTCNT5' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, GHTCNT6, 'GHTCNT6' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, WESNN1, 'WESNN1' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, WESNN2, 'WESNN2' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, WESNN3, 'WESNN3' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, HTSNNN1, 'HTSNNN1' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, HTSNNN2, 'HTSNNN2' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, HTSNNN3, 'HTSNNN3' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, SNDZN1, 'SNDZN1' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, SNDZN2, 'SNDZN2' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, SNDZN3, 'SNDZN3' ,rc=status) - VERIFY_(status) + _VERIFY(status) ! This counter is relative to ens_id ens_id = ens_id + 1 @@ -2039,9 +1966,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) real, dimension(:), pointer :: TP1 real, dimension(:), pointer :: TPSURF real, dimension(:), pointer :: WCSF - real, dimension(:), pointer :: WESNN1 - real, dimension(:), pointer :: WESNN2 - real, dimension(:), pointer :: WESNN3 + real, dimension(:), pointer :: SWE real, dimension(:), pointer :: VEGCLS real, dimension(:), pointer :: SOILCLS @@ -2065,25 +1990,24 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) real, dimension(:), pointer :: TB_H_enavg real, dimension(:), pointer :: TB_V_enavg - real, allocatable, dimension(:) :: SWE real, allocatable, dimension(:) :: sfmc_mwRTM, tsoil_mwRTM real, allocatable, dimension(:) :: dummy_real real, allocatable, dimension(:) :: Tb_v_tmp, TB_h_tmp - integer :: N_catl + integer :: N_catl, n, mpierr type(MAPL_LocStream) :: locstream - !integer , save :: ens_id = 0 + logical :: is_nodata, all_nodata_l, all_nodata call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) Iam=trim(COMP_NAME)//"::RUN" call MAPL_GetPointer(export, TB_H_enavg, 'TB_LAND_1410MHZ_40DEG_HPOL' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(export, TB_V_enavg, 'TB_LAND_1410MHZ_40DEG_VPOL' ,rc=status) - VERIFY_(STATUS) + _VERIFY(STATUS) !if HISTORY does not ask for these varaibles, no calculation necessary if (.not. associated(TB_H_enavg) .or. .not. associated(TB_V_enavg)) then @@ -2091,103 +2015,39 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) endif call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(status) + _VERIFY(status) call MAPL_Get(MAPL, LocStream=locstream,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_LocStreamGet(locstream, NT_LOCAL=N_catl,rc=status) - VERIFY_(status) + _VERIFY(status) ! Pointers to internals !---------------------- call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) - VERIFY_(status) - - ! RRTBHISTORY - do we need to fill "mwRTM_param" this here and in RUN? Can this be moved to Initialize? - - call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL,SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, WANGWP , 'MWRTM_WANGWP' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHHMIN , 'MWRTM_RGHHMIN' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHHMAX , 'MWRTM_RGHHMAX' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHWMIN , 'MWRTM_RGHWMIN' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHWMAX , 'MWRTM_RGHWMAX' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHNRH , 'MWRTM_RGHNRH' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHNRV , 'MWRTM_RGHNRV' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) - VERIFY_(STATUS) - call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) - VERIFY_(STATUS) - - allocate(mwRTM_param(N_catl)) - mwRTM_param(:)%sand = SAND(:) - mwRTM_param(:)%vegcls = nint(VEGCLS(:)) - mwRTM_param(:)%soilcls = nint(SOILCLS(:)) - mwRTM_param(:)%clay = CLAY(:) - mwRTM_param(:)%poros = mw_POROS(:) - mwRTM_param(:)%wang_wt = WANGWT(:) - mwRTM_param(:)%wang_wp = WANGWP(:) - mwRTM_param(:)%rgh_hmin = RGHHMIN(:) - mwRTM_param(:)%rgh_hmax = RGHHMAX(:) - mwRTM_param(:)%rgh_wmin = RGHWMIN(:) - mwRTM_param(:)%rgh_wmax = RGHWMAX(:) - mwRTM_param(:)%rgh_Nrh = RGHNRH(:) - mwRTM_param(:)%rgh_Nrv = RGHNRV(:) - mwRTM_param(:)%rgh_polmix= RGHPOLMIX(:) - mwRTM_param(:)%omega = OMEGA(:) - mwRTM_param(:)%bh = BH(:) - mwRTM_param(:)%bv = bv(:) - mwRTM_param(:)%lewt = LEWT(:) + _VERIFY(status) + + call get_mwrtm_param(INTERNAL, rc=status) + _VERIFY(STATUS) + !WE DO NOT HAVE "mwRTM_param", but ask for TB from HISTORY, report error + if (all_nodata) then + _ASSERT(.false., "no mwRTM data, do not ask for TB ensemble average") + endif call MAPL_GetPointer(import, LAI, 'LAI' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, TP1, 'TP1' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, WCSF, 'WCSF' ,rc=status) - VERIFY_(status) + _VERIFY(status) call MAPL_GetPointer(import, TPSURF, 'TPSURF' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, WESNN1, 'WESNN1' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, WESNN2, 'WESNN2' ,rc=status) - VERIFY_(status) - call MAPL_GetPointer(import, WESNN3, 'WESNN3' ,rc=status) - VERIFY_(STATUS) - - - ! - ! THIS NEEDS TO WORK EVEN IF WE DO NOT HAVE "mwRTM_param" - ! - ! NOT SURE IF WE ALWAYS HAVE "mwRTM_param" WHEN THE LandAssim GC IS RUNNING - ! - ! IT IS OK TO FILL TB WITH NO-DATA-VALUES IF "mwRTM_param" IS NOT AVAILABLE + _VERIFY(status) + call MAPL_GetPointer(import, SWE, 'SNOWMASS' ,rc=status) + _VERIFY(status) ! convert Catchment model variables into inputs suitable for the mwRTM ! NOTE: input tp must be in degree Celsius! - allocate(sfmc_mwRTM(N_catl), tsoil_mwRTM (N_catl)) - call catch2mwRTM_vars( & + allocate(sfmc_mwRTM(N_catl), tsoil_mwRTM (N_catl)) + call catch2mwRTM_vars( & N_catl, & cat_param%vegcls, & ! intent(in), 'ITY' from imports (*cat_param* vegcls) --- not used anymore but keep for now cat_param%poros, & ! intent(in), 'POROS' from imports (*cat_param* poros) @@ -2205,8 +2065,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) ! IF NEEDED, USE DUMMY VARIABLES FOR tile_coord%elev AND Tair ALONG WITH AN IF STATEMENT AS FOLLOWS: allocate(TB_h_tmp(N_catl), TB_v_tmp(N_catl)) - allocate(SWE(N_catl)) - SWE(:) = WESNN1(:) + WESNN2(:) + WESNN2(:) ! WHY NOT IMPORT SNOMASS? + if (.not. incl_atm_terms) then allocate(dummy_real(N_catl)) ! DO WE EVEN NEED TO ALLOCATE? call mwRTM_get_Tb( & @@ -2219,7 +2078,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) dummy_real, & ! intent(in), "Tair", not used as long as "incl_atm_terms=.false." incl_atm_terms, & Tb_h_tmp, Tb_v_tmp ) ! intent(out) 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' - deallocate(Tair_Not_used, elev_not_used) + deallocate(dummy_real) else _ASSERT(.false., "incl_atm_terms should be .false.") end if @@ -2241,7 +2100,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) TB_H_enavg(:) = TB_H_enavg(:)/NUM_ENSEMBLE endif - deallocate(SWE, Tb_h_tmp, Tb_v_tmp) + deallocate(Tb_h_tmp, Tb_v_tmp) RETURN_(_SUCCESS) end subroutine CALC_LAND_TB @@ -2354,23 +2213,23 @@ subroutine Finalize(gc, import, export, clock, rc) integer :: ens, nymd, nhms ! Get component's name and setup traceback handle call ESMF_GridCompget(gc, name=comp_name, rc=status) - VERIFY_(status) + _VERIFY(status) Iam = trim(comp_name) // "::Finalize" call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) if (master_proc) then call finalize_obslog() Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) - VERIFY_(STATUS) + _VERIFY(STATUS) call MAPL_DateStampGet( clock, datestamp, rc=status) - VERIFY_(STATUS) + _VERIFY(STATUS) read(datestamp(1:8),*) nymd read(datestamp(10:13),*) nhms @@ -2379,18 +2238,117 @@ subroutine Finalize(gc, import, export, clock, rc) write(id_string,'(I4.4)') ens + FIRST_ENS_ID seed_fname = "" call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) - VERIFY_(STATUS) + _VERIFY(STATUS) call write_pert_rseed(trim(seed_fname), Pert_rseed_r8(:,ens+1)) enddo endif ! Call Finalize for every child call MAPL_GenericFinalize(gc, import, export, clock, rc=status) - VERIFY_(status) + _VERIFY(status) ! End RETURN_(ESMF_SUCCESS) end subroutine Finalize +subroutine get_mwrtm_param(internal, rc) + type(ESMF_State), intent(inout) :: INTERNAL + integer, optional, intent(out) :: rc + + real, dimension(:), pointer :: VEGCLS + real, dimension(:), pointer :: SOILCLS + real, dimension(:), pointer :: SAND + real, dimension(:), pointer :: CLAY + real, dimension(:), pointer :: mw_POROS + real, dimension(:), pointer :: WANGWT + real, dimension(:), pointer :: WANGWP + real, dimension(:), pointer :: RGHHMIN + real, dimension(:), pointer :: RGHHMAX + real, dimension(:), pointer :: RGHWMAX + real, dimension(:), pointer :: RGHWMIN + real, dimension(:), pointer :: RGHNRH + real, dimension(:), pointer :: RGHNRV + real, dimension(:), pointer :: RGHPOLMIX + real, dimension(:), pointer :: OMEGA + real, dimension(:), pointer :: BH + real, dimension(:), pointer :: BV + real, dimension(:), pointer :: LEWT + + integer :: N_catl, n, mpierr, status + logical :: is_nodata, all_nodata_l + + if(allocated(mwRTM_param)) then + _RETURN(_SUCCESS) + endif + + call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL,SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, WANGWP , 'MWRTM_WANGWP' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHHMIN , 'MWRTM_RGHHMIN' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHHMAX , 'MWRTM_RGHHMAX' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHWMIN , 'MWRTM_RGHWMIN' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHWMAX , 'MWRTM_RGHWMAX' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHNRH , 'MWRTM_RGHNRH' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHNRV , 'MWRTM_RGHNRV' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) + _VERIFY(STATUS) + + N_catl = size(sand,1) + allocate(mwRTM_param(N_catl)) + mwRTM_param(:)%sand = SAND(:) + mwRTM_param(:)%vegcls = nint(VEGCLS(:)) + mwRTM_param(:)%soilcls = nint(SOILCLS(:)) + mwRTM_param(:)%clay = CLAY(:) + mwRTM_param(:)%poros = mw_POROS(:) + mwRTM_param(:)%wang_wt = WANGWT(:) + mwRTM_param(:)%wang_wp = WANGWP(:) + mwRTM_param(:)%rgh_hmin = RGHHMIN(:) + mwRTM_param(:)%rgh_hmax = RGHHMAX(:) + mwRTM_param(:)%rgh_wmin = RGHWMIN(:) + mwRTM_param(:)%rgh_wmax = RGHWMAX(:) + mwRTM_param(:)%rgh_Nrh = RGHNRH(:) + mwRTM_param(:)%rgh_Nrv = RGHNRV(:) + mwRTM_param(:)%rgh_polmix= RGHPOLMIX(:) + mwRTM_param(:)%omega = OMEGA(:) + mwRTM_param(:)%bh = BH(:) + mwRTM_param(:)%bv = bv(:) + mwRTM_param(:)%lewt = LEWT(:) + + all_nodata_l = .true. + do n=1,N_catl + call mwRTM_param_nodata_check(mwRTM_param(n), is_nodata ) + if (.not. is_nodata) all_nodata_l = .false. + end do + + call MPI_AllReduce(all_nodata_l, all_nodata, 1, MPI_LOGICAL, & + MPI_LOR, mpicomm, mpierr) + _RETURN(_SUCCESS) +end subroutine + end module GEOS_LandAssimGridCompMod From 97d7d114fd665b9f165e6f4746d58b8c4a9721e8 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 15 May 2020 09:45:47 -0400 Subject: [PATCH 05/19] Change land_assim to logical. Introduce logical mwRTM --- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 17 ++++++++++------- .../GEOS_LandAssimGridComp.F90 | 8 +++++++- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index 488e1d41..f9c71f7d 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -58,7 +58,8 @@ module GEOS_LdasGridCompMod integer,allocatable :: LANDPERT(:) integer :: ENSAVG, LANDASSIM integer :: NUM_ENSEMBLE - integer :: land_assim + logical :: land_assim + logical :: mwRTM contains !BOP @@ -141,7 +142,9 @@ subroutine SetServices(gc, rc) call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, land_assim, Label="LAND_ASSIM:", DEFAULT= 0, RC=STATUS) + call MAPL_GetResource ( MAPL, land_assim, Label="LAND_ASSIM:", DEFAULT = .false., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetResource ( MAPL, mwRTM, Label="mwRTM:", DEFAULT = .false., RC=STATUS) VERIFY_(STATUS) allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) @@ -189,7 +192,7 @@ subroutine SetServices(gc, rc) ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) VERIFY_(status) - if(land_assim > 0 ) then + if(land_assim .or. mwRTM ) then LANDASSIM = MAPL_AddChild(gc, name='LANDASSIM', ss=LandAssimSetServices, rc=status) VERIFY_(status) endif @@ -260,7 +263,7 @@ subroutine SetServices(gc, rc) VERIFY_(status) enddo - if(land_assim > 0) then + if(land_assim .or. mwRTM) then call MAPL_AddConnectivity( & gc, & SHORT_NAME = ['POROS ', 'COND ','PSIS ','BEE ','WPWET ','GNU ','VGWMAX', & @@ -688,7 +691,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) enddo - if (land_assim > 0) 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) @@ -873,7 +876,7 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_GridCompRun(gcs(ENSAVG), importState=gex(igc), exportState=gex(ENSAVG), clock=clock,phase=2, userRC=status) VERIFY_(status) - if(land_assim > 0) then + if( mwRTM ) then ! calculate ensemble-average L-band Tb (add up and normalize after last member has been added) call ESMF_GridCompRun(gcs(LANDASSIM), importState=gex(igc), exportState=gex(LANDASSIM), clock=clock,phase=3, userRC=status) VERIFY_(status) @@ -893,7 +896,7 @@ subroutine Run(gc, import, export, clock, rc) enddo !run land assim - if (land_assim == 1) then + if (land_assim) then igc = LANDASSIM call MAPL_TimerOn(MAPL, gcnames(igc)) !import state is the export from ens_GridComp, assimilation run diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 7351f1ef..9f50f1a1 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -110,7 +110,8 @@ module GEOS_LandAssimGridCompMod real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) type(mwRTM_param_type),dimension(:),allocatable :: mwRTM_param logical :: all_nodata ! no data for mwRTM_param - +logical :: land_assim +logical :: mwRTM contains !BOP @@ -151,6 +152,11 @@ subroutine SetServices ( GC, RC ) call MAPL_GetObjectFromGC(gc, MAPL, rc=status) _VERIFY(status) + call MAPL_GetResource ( MAPL, land_assim, Label="LAND_ASSIM:", DEFAULT = .false., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetResource ( MAPL, mwRTM, Label="mwRTM:", DEFAULT = .false., RC=STATUS) + VERIFY_(STATUS) + ! Register services for this component call MAPL_GridCompSetEntryPoint( & gc, & From 4fead707fc50ffc1434d8e38826cc21f2243716c Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 15 May 2020 11:43:52 -0400 Subject: [PATCH 06/19] simplify landassim init for mwRTM only --- .../GEOS_LandAssimGridComp.F90 | 39 ++++++++++++------- 1 file changed, 25 insertions(+), 14 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 9f50f1a1..f0f4b939 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -1008,17 +1008,26 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_TimerOn(MAPL, "Initialize") collect_tb_counter = 0 - - call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) - _VERIFY(STATUS) call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) _VERIFY(STATUS) call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) _VERIFY(STATUS) - call init_log( myid, numprocs, master_proc ) + + if ( .not. land_assim) then + ! to arrive here, mwRTM must be .true. + call MAPL_GenericInitialize(gc, import, export, clock, rc=status) + _VERIFY(status) + + call MAPL_TimerOff(MAPL, "Initialize") + call MAPL_TimerOff(MAPL, "TOTAL") + RETURN_(ESMF_SUCCESS) + endif + + call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) + _VERIFY(STATUS) ! Get current time call ESMF_ClockGet(clock, currTime=CurrentTime, rc=status) @@ -1370,7 +1379,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Pointers to internals !---------------------- if (need_mwRTM_param) then - call get_mwrtm_param(INTERNAL, rc=STATUS) + call get_mwrtm_param(INTERNAL, N_catl, rc=STATUS) _VERIFY(STATUS) endif @@ -1966,7 +1975,6 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) ! MAPL variables type(MAPL_MetaComp), pointer :: MAPL=>null() ! MAPL obj type(ESMF_State) :: INTERNAL - type(mwRTM_param_type),dimension(:),allocatable :: mwRTM_param real, dimension(:), pointer :: LAI real, dimension(:), pointer :: TP1 @@ -2004,7 +2012,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) integer :: N_catl, n, mpierr type(MAPL_LocStream) :: locstream - logical :: is_nodata, all_nodata_l, all_nodata + logical :: is_nodata, all_nodata_l call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) _VERIFY(STATUS) @@ -2032,7 +2040,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) _VERIFY(status) - call get_mwrtm_param(INTERNAL, rc=status) + call get_mwrtm_param(INTERNAL, N_catl, rc=status) _VERIFY(STATUS) !WE DO NOT HAVE "mwRTM_param", but ask for TB from HISTORY, report error if (all_nodata) then @@ -2106,7 +2114,7 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) TB_H_enavg(:) = TB_H_enavg(:)/NUM_ENSEMBLE endif - deallocate(Tb_h_tmp, Tb_v_tmp) + deallocate(Tb_h_tmp, Tb_v_tmp, sfmc_mwRTM, tsoil_mwRTM) RETURN_(_SUCCESS) end subroutine CALC_LAND_TB @@ -2258,8 +2266,9 @@ subroutine Finalize(gc, import, export, clock, rc) end subroutine Finalize -subroutine get_mwrtm_param(internal, rc) +subroutine get_mwrtm_param(internal,N_catl, rc) type(ESMF_State), intent(inout) :: INTERNAL + integer, intent(in) :: N_catl integer, optional, intent(out) :: rc real, dimension(:), pointer :: VEGCLS @@ -2281,7 +2290,7 @@ subroutine get_mwrtm_param(internal, rc) real, dimension(:), pointer :: BV real, dimension(:), pointer :: LEWT - integer :: N_catl, n, mpierr, status + integer :: N_catl_tmp, n, mpierr, status logical :: is_nodata, all_nodata_l if(allocated(mwRTM_param)) then @@ -2325,7 +2334,9 @@ subroutine get_mwrtm_param(internal, rc) call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) _VERIFY(STATUS) - N_catl = size(sand,1) + N_catl_tmp = size(sand,1) + _ASSERT(N_catl_tmp == N_catl, "sanity check: N_catl should be consisten") + allocate(mwRTM_param(N_catl)) mwRTM_param(:)%sand = SAND(:) mwRTM_param(:)%vegcls = nint(VEGCLS(:)) From d3a689da5603f299a1b8c3e096bef696d2aa796e Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Fri, 15 May 2020 11:57:32 -0400 Subject: [PATCH 07/19] cleanup finalize of landassim grid comp --- .../GEOS_LandAssimGridComp.F90 | 137 +++++++++--------- 1 file changed, 70 insertions(+), 67 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index f0f4b939..31042832 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -2198,73 +2198,6 @@ subroutine check(status) end subroutine check end subroutine write_pert_rseed -!BOP -! !IROTUINE: Finalize -- finalize method for LDAS GC -! !INTERFACE: -subroutine Finalize(gc, import, export, clock, rc) - - ! !ARGUMENTS: - - type(ESMF_GridComp), intent(inout) :: gc ! Gridded component - type(ESMF_State), intent(inout) :: import ! Import state - type(ESMF_State), intent(inout) :: export ! Export state - type(ESMF_Clock), intent(inout) :: clock ! The clock - integer, optional, intent( out) :: rc ! Error code - - !EOP - - ! ErrLog variables - integer :: status - character(len=ESMF_MAXSTR) :: Iam - character(len=ESMF_MAXSTR) :: comp_name - type(MAPL_MetaComp), pointer :: MAPL=>null() - character(len=300) :: seed_fname - character(len=300) :: fname_tpl - character(len=300) :: out_path - character(len=ESMF_MAXSTR) :: exp_id - character(len=4) :: id_string - character(len=14):: datestamp - integer :: ens, nymd, nhms - ! Get component's name and setup traceback handle - call ESMF_GridCompget(gc, name=comp_name, rc=status) - _VERIFY(status) - Iam = trim(comp_name) // "::Finalize" - - call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) - _VERIFY(STATUS) - call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) - _VERIFY(STATUS) - - if (master_proc) then - call finalize_obslog() - Pert_rseed_r8 = Pert_rseed - call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) - _VERIFY(STATUS) - call MAPL_DateStampGet( clock, datestamp, rc=status) - _VERIFY(STATUS) - - read(datestamp(1:8),*) nymd - read(datestamp(10:13),*) nhms - nhms = nhms*100 - do ens = 0, NUM_ENSEMBLE-1 - write(id_string,'(I4.4)') ens + FIRST_ENS_ID - seed_fname = "" - call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) - _VERIFY(STATUS) - call write_pert_rseed(trim(seed_fname), Pert_rseed_r8(:,ens+1)) - enddo - endif - - ! Call Finalize for every child - call MAPL_GenericFinalize(gc, import, export, clock, rc=status) - _VERIFY(status) - - ! End - RETURN_(ESMF_SUCCESS) - -end subroutine Finalize subroutine get_mwrtm_param(internal,N_catl, rc) type(ESMF_State), intent(inout) :: INTERNAL @@ -2368,4 +2301,74 @@ subroutine get_mwrtm_param(internal,N_catl, rc) _RETURN(_SUCCESS) end subroutine +!BOP +! !IROTUINE: Finalize -- finalize method for LDAS GC +! !INTERFACE: +subroutine Finalize(gc, import, export, clock, rc) + + ! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: import ! Import state + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + + !EOP + + ! ErrLog variables + integer :: status + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: comp_name + type(MAPL_MetaComp), pointer :: MAPL=>null() + character(len=300) :: seed_fname + character(len=300) :: fname_tpl + character(len=300) :: out_path + character(len=ESMF_MAXSTR) :: exp_id + character(len=4) :: id_string + character(len=14):: datestamp + integer :: ens, nymd, nhms + ! Get component's name and setup traceback handle + call ESMF_GridCompget(gc, name=comp_name, rc=status) + _VERIFY(status) + Iam = trim(comp_name) // "::Finalize" + + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) + _VERIFY(STATUS) + + if( land_assim) then + call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) + _VERIFY(STATUS) + + if (master_proc) then + call finalize_obslog() + Pert_rseed_r8 = Pert_rseed + call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", & + DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) + _VERIFY(STATUS) + call MAPL_DateStampGet( clock, datestamp, rc=status) + _VERIFY(STATUS) + + read(datestamp(1:8),*) nymd + read(datestamp(10:13),*) nhms + nhms = nhms*100 + do ens = 0, NUM_ENSEMBLE-1 + write(id_string,'(I4.4)') ens + FIRST_ENS_ID + seed_fname = "" + call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) + _VERIFY(STATUS) + call write_pert_rseed(trim(seed_fname), Pert_rseed_r8(:,ens+1)) + enddo + endif + endif ! land_assim + + ! Call Finalize for every child + call MAPL_GenericFinalize(gc, import, export, clock, rc=status) + _VERIFY(status) + + RETURN_(ESMF_SUCCESS) + +end subroutine Finalize end module GEOS_LandAssimGridCompMod From 0759f7698915d174b149e79ac329ca8b726dd169 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 15 May 2020 13:35:40 -0400 Subject: [PATCH 08/19] - changed resource parameter LAND_ASSIM back to string (Yes/No) - use existing resource parameter MWRTM_FILE to determine local logical mwRTM - cleanup: - use scalar integer for identifying data atmosphere gridded component - renamed DATAATM to METFORCE to be consistent with Grid Comp name --- src/Applications/LDAS_App/GEOSldas_LDAS.rc | 7 +- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 125 ++++++++++-------- 2 files changed, 75 insertions(+), 57 deletions(-) diff --git a/src/Applications/LDAS_App/GEOSldas_LDAS.rc b/src/Applications/LDAS_App/GEOSldas_LDAS.rc index 801cdde4..c4ebd5e5 100644 --- a/src/Applications/LDAS_App/GEOSldas_LDAS.rc +++ b/src/Applications/LDAS_App/GEOSldas_LDAS.rc @@ -94,7 +94,12 @@ FIRST_ENS_ID: 0 # NML_INPUT_PATH: '' -# ---- Microwave Radiative Transfer Model (mwRTM) parameter file name (nc4 format) used for Tb assimilation +# ---- Microwave Radiative Transfer Model (mwRTM) parameter file name (nc4 format) +# +# Must be provided for +# - output of Tb through HISTORY or +# - Tb assimilation. +# Otherwise, leave unspecified (i.e., use default empty string). # # This file can be converted from binary with the program mwrtm_bin2nc4.x. # If empty or commented out, GEOSldas will search the restart directory. diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index f9c71f7d..db02deda 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -44,22 +44,25 @@ module GEOS_LdasGridCompMod public SetServices - ! !DESCRIPTION: This gridded component (GC) combines the GridComps - ! LDDATAATM, LAND, LAKE, LANDICE, SALTWATER and LANA into a - ! new composite LDAS GricComp. + ! !DESCRIPTION: This gridded component (GC) combines the GridComps: + ! METFORCE, LAND, LANDPERT, ENSAVG, and LANDASSIM + ! into a new composite LDAS GricComp. + ! Include later: LAKE, LANDICE(?), SALTWATER(?) !EOP include 'mpif.h' ! All children - integer,allocatable :: DATAATM(:) integer,allocatable :: LAND(:) integer,allocatable :: LANDPERT(:) - integer :: ENSAVG, LANDASSIM + integer :: METFORCE, ENSAVG, LANDASSIM + + ! other global variables integer :: NUM_ENSEMBLE logical :: land_assim logical :: mwRTM + contains !BOP @@ -87,6 +90,7 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: id_string,childname, fmt_str + character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file integer :: ens_id_width ! Local variables type(T_TILECOORD_STATE), pointer :: tcinternal @@ -94,6 +98,8 @@ subroutine SetServices(gc, rc) type(ESMF_Config) :: CF + + ! Begin... ! Get my name and setup traceback handle @@ -137,21 +143,39 @@ subroutine SetServices(gc, rc) !create ensemble children call MAPL_GetObjectFromGC(gc, MAPL, rc=status) VERIFY_(status) - call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) + call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) + call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, land_assim, Label="LAND_ASSIM:", DEFAULT = .false., RC=STATUS) + ! ^^^^^^^^^^^^^^^^^^^^^ CLEAN UP THE FOLLOWING COMMENTS WHEN WE ARE DONE WITH THE EDITS HERE. + ! + ! THE CHANGES HERE ARE AN ATTEMPT TO AVOID CHANGING THE INTERFACE + ! 1) keep the LAND_ASSIM resource parameter a string (Yes/No) + ! 2) use the MWRTM_FILE resource parameter to set the local logical mwRTM + ! --> if MWRTM_FILE is an empty string, mwRTM=.false., otherwise mwRTM=.true. + ! that is... if the user does NOT provide this file, don't attempt to compute Tbs; + ! if the user provides this file, go ahead and attempt to compute Tbs, still check "all_nodata" later) + ! I think with these changes we no longer need to change "ldas_setup". + ! (But it might still be good to clean up "--runmodel"...) + ! IMPORTANT: I'm not sure the new lines below for "mwRTM" are quite correct. Please double-check carefully!!! + ! + call MAPL_GetResource ( MAPL, LAND_ASSIM_STR, Label="LAND_ASSIM:", DEFAULT="NO", RC=STATUS) VERIFY_(STATUS) - call MAPL_GetResource ( MAPL, mwRTM, Label="mwRTM:", DEFAULT = .false., RC=STATUS) + LAND_ASSIM_STR = ESMF_UtilStringUpperCase(LAND_ASSIM_STR, rc=STATUS) VERIFY_(STATUS) + land_assim = (trim(LAND_ASSIM_STR) /= 'NO') + + call MAPL_GetResource ( MAPL, mwRTM_file, Label="MWRTM_FILE:", DEFAULT='', RC=STATUS) + VERIFY_(STATUS) + mwRTM = ( len_trim(mwRTM_file) /= 0 ) + ! + ! ^^^^^^^^^^^^^^^^^^^^ CLEAN UP THE ABOVE COMMENTS WHEN WE ARE DONE WITH THE EDITS HERE. allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) - allocate(DATAATM(1)) - ! one dataatm provides all the data - ens_id(1)=0 ! id start form 0 + ! one METFORCE provides all the (unperturbed) forcing data + ens_id(1)=0 ! id start form 0 <== ?? IS THIS INCONSISTENT WITH "FIRST_ENS_ID" USED IN GEOS_LandAssimGridComp.F90? if(NUM_ENSEMBLE ==1 ) then id_string='' else @@ -160,8 +184,8 @@ subroutine SetServices(gc, rc) write(id_string, fmt_str) ens_id(1) endif id_string=trim(id_string) - childname='DATAATM'//trim(id_string) - DATAATM(1) = MAPL_AddChild(gc, name=childname, ss=MetforceSetServices, rc=status) + childname='METFORCE'//trim(id_string) ! <== ?? DO WE NEED TO APPEND id_string? CAN THIS (AND THE PRECEDING LINES) BE REMOVED? + METFORCE = MAPL_AddChild(gc, name=childname, ss=MetforceSetServices, rc=status) VERIFY_(status) do i=1,NUM_ENSEMBLE @@ -175,11 +199,6 @@ subroutine SetServices(gc, rc) id_string=trim(id_string) - ! note: different dataatm provide different data - ! childname='DATAATM'//trim(id_string) - ! DATAATM(i) = MAPL_AddChild(gc, name=childname, ss=MetforceSetServices, rc=status) - ! VERIFY_(status) - childname='LANDPERT'//trim(id_string) LANDPERT(i) = MAPL_AddChild(gc, name=childname, ss=LandPertSetServices, rc=status) VERIFY_(status) @@ -199,14 +218,13 @@ subroutine SetServices(gc, rc) ! Connections do i=1,NUM_ENSEMBLE - ! -DATAATM-feeds-LANDPERT's-imports- + ! -METFORCE-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & SHORT_NAME = ['Tair ', 'Qair ', 'Psurf ', 'Rainf_C', 'Rainf ', & 'Snowf ', 'LWdown ', 'SWdown ', 'SWnet ', 'PARdrct', & 'PARdffs', 'Wind ', 'RefH '], & - ! SRC_ID = DATAATM(i), & - SRC_ID = DATAATM(1), & + SRC_ID = METFORCE, & DST_ID = LANDPERT(i), & rc = status & ) @@ -228,15 +246,14 @@ subroutine SetServices(gc, rc) rc = status & ) VERIFY_(status) - ! -DATAATM-feeds-LAND's-imports- + ! -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 = DATAATM(i), & - SRC_ID = DATAATM(1), & + SRC_ID = METFORCE, & DST_NAME = ['PS ', 'DZ ', & 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & @@ -246,34 +263,34 @@ subroutine SetServices(gc, rc) ) VERIFY_(status) ! -CATCH-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 & + 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 - 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), & - DST_ID = LANDASSIM, & - rc = status & + 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), & + DST_ID = LANDASSIM, & + rc = status & ) VERIFY_(status) endif @@ -659,8 +676,8 @@ subroutine Initialize(gc, import, export, clock, rc) tcinternal%grid_f = tile_grid_f tcinternal%grid_l = tile_grid_l - call MAPL_GetObjectFromGC(gcs(DATAATM(1)), CHILD_MAPL, rc=status) - VERIFY_(status) ! CHILD = DATAATM + call MAPL_GetObjectFromGC(gcs(METFORCE), CHILD_MAPL, rc=status) + VERIFY_(status) ! CHILD = METFORCE call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) @@ -668,7 +685,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) ! CHILD = ens_avg call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) - call ESMF_UserCompSetInternalState(gcs(DATAATM(1)), 'TILE_COORD', tcwrap, status) + call ESMF_UserCompSetInternalState(gcs(METFORCE), 'TILE_COORD', tcwrap, status) VERIFY_(status) do i = 1,NUM_ENSEMBLE @@ -676,10 +693,6 @@ 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(DATAATM(i)), CHILD_MAPL, rc=status) - !VERIFY_(status) ! CHILD = DATAATM - !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) @@ -837,7 +850,7 @@ subroutine Run(gc, import, export, clock, rc) enddo - igc = DATAATM(1) + igc = METFORCE call MAPL_TimerOn(MAPL, gcnames(igc)) call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, userRC=status) VERIFY_(status) From 49144de7fdede37357bf47b02667460a0e78b128 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Fri, 15 May 2020 17:57:49 -0400 Subject: [PATCH 09/19] additional edits for Tb output from HISTORY - renamed "all_nodata" to "mwRTM_all_nodata" - eliminated local logical "need_mwRTM_param" (now obsolete) - logical AND instead of OR for MPI_Allreduce of all_nodata_l - fixed indents and white space throughout --- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 4 + .../GEOS_LandAssimGridComp.F90 | 3076 ++++++++--------- 2 files changed, 1535 insertions(+), 1545 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index db02deda..99720554 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -172,6 +172,10 @@ subroutine SetServices(gc, rc) ! ! ^^^^^^^^^^^^^^^^^^^^ CLEAN UP THE ABOVE COMMENTS WHEN WE ARE DONE WITH THE EDITS HERE. + + ! ADD STOP HERE IF (LSM_CHOICE/=1) .and. (mwRTM .or. land_assim) ?? + ! ==> avoid users trying to run LandAssim GC with CatchCN + allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) ! one METFORCE provides all the (unperturbed) forcing data diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 31042832..15c886b2 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -3,161 +3,159 @@ !============================================================================= module GEOS_LandAssimGridCompMod -!BOP -! !DESCRIPTION: -! -! {\tt Obs} is a gridded component to -! {\tt Obs} has no children. - -! -! !USES: - + !BOP + ! !DESCRIPTION: + ! + ! {\tt Obs} is a gridded component to + ! {\tt Obs} has no children. + + ! + ! !USES: + use ESMF use MAPL_Mod - use ESMF_CFIOMOD, only: ESMF_CFIOstrTemplate - !USE GEOS_MOD - - use LDAS_TileCoordType, only: tile_coord_type - use LDAS_TileCoordType, only: grid_def_type - use LDAS_TileCoordType, only: T_TILECOORD_STATE - use LDAS_TileCoordType, only: TILECOORD_WRAP - - use enkf_types, only: obs_type,obs_param_type - use nr_ran2_gasdev, ONLY: & - NRANDSEED, init_randseed - use land_pert_routines, only: get_init_pert_rseed - use LDAS_ensdrv_mpi, only: mpicomm,numprocs,myid - use LDAS_ensdrv_mpi, only: master_proc - use LDAS_ensdrv_mpi, only: MPI_obs_param_type + use ESMF_CFIOMOD, only: ESMF_CFIOstrTemplate - use LDAS_DateTimeMod,ONLY: date_time_type - use LDAS_ensdrv_Globals, only: logunit, nodata_generic - - use LDAS_ConvertMod, ONLY: esmf2ldas - use LDAS_DriverTypes, ONLY: & - met_force_type - - use GEOS_LandPertGridCompMod, only: N_force_pert, N_progn_pert - use GEOS_LandPertGridCompMod, only: progn_pert_param - use GEOS_LandPertGridCompMod, only: force_pert_param -! use GEOS_LandPertGridCompMod, only: pert_rseed=>pert_iseed - - use lsm_routines, only: DZGT - use GEOS_EnsGridCompMod, only: cat_progn=>catch_progn - use GEOS_EnsGridCompMod, only: cat_param=>catch_param - use mwRTM_types, only: mwRTM_param_type, mwRTM_param_nodata_check - use catch_bias_types, only: obs_bias_type - use catch_bias_types, only: cat_bias_param_type - use catch_types, only: cat_progn_type - use catch_types, only: cat_param_type - use catch_types, only: assignment(=), operator (+), operator (/) - use clsm_bias_routines, only: initialize_obs_bias - use clsm_bias_routines, only: read_cat_bias_inputs - - use clsm_ensupd_upd_routines, only: read_ens_upd_inputs - use clsm_ensupd_upd_routines, only: finalize_obslog - use clsm_ensupd_glob_param, only: echo_clsm_ensupd_glob_param - use clsm_ensupd_enkf_update, only: get_enkf_increments - use clsm_ensupd_enkf_update, only: apply_enkf_increments - use clsm_ensupd_enkf_update, only: output_incr_etc - use clsm_ensupd_enkf_update, only: write_smapL4SMaup - use clsm_ensdrv_out_routines, only: init_log, GEOS_output_smapL4SMlmc - use mwRTM_routines, only : mwRTM_get_Tb, catch2mwRTM_vars - - use, intrinsic :: ieee_arithmetic - + use LDAS_TileCoordType, only: tile_coord_type + use LDAS_TileCoordType, only: grid_def_type + use LDAS_TileCoordType, only: T_TILECOORD_STATE + use LDAS_TileCoordType, only: TILECOORD_WRAP + + use enkf_types, only: obs_type,obs_param_type + use nr_ran2_gasdev, only: NRANDSEED, init_randseed + use land_pert_routines, only: get_init_pert_rseed + use LDAS_ensdrv_mpi, only: mpicomm,numprocs,myid + use LDAS_ensdrv_mpi, only: master_proc + use LDAS_ensdrv_mpi, only: MPI_obs_param_type + + use LDAS_DateTimeMod, only: date_time_type + use LDAS_ensdrv_Globals, only: logunit, nodata_generic + + use LDAS_ConvertMod, only: esmf2ldas + use LDAS_DriverTypes, only: met_force_type + + use GEOS_LandPertGridCompMod, only: N_force_pert, N_progn_pert + use GEOS_LandPertGridCompMod, only: progn_pert_param + use GEOS_LandPertGridCompMod, only: force_pert_param -implicit none + use lsm_routines, only: DZGT + use GEOS_EnsGridCompMod, only: cat_progn=>catch_progn + use GEOS_EnsGridCompMod, only: cat_param=>catch_param + use mwRTM_types, only: mwRTM_param_type, mwRTM_param_nodata_check + use catch_bias_types, only: obs_bias_type + use catch_bias_types, only: cat_bias_param_type + use catch_types, only: cat_progn_type + use catch_types, only: cat_param_type + use catch_types, only: assignment(=), operator (+), operator (/) + use clsm_bias_routines, only: initialize_obs_bias + use clsm_bias_routines, only: read_cat_bias_inputs + + use clsm_ensupd_upd_routines, only: read_ens_upd_inputs + use clsm_ensupd_upd_routines, only: finalize_obslog + use clsm_ensupd_glob_param, only: echo_clsm_ensupd_glob_param + use clsm_ensupd_enkf_update, only: get_enkf_increments + use clsm_ensupd_enkf_update, only: apply_enkf_increments + use clsm_ensupd_enkf_update, only: output_incr_etc + use clsm_ensupd_enkf_update, only: write_smapL4SMaup + use clsm_ensdrv_out_routines, only: init_log, GEOS_output_smapL4SMlmc + use mwRTM_routines, only : mwRTM_get_Tb, catch2mwRTM_vars -include 'mpif.h' + use, intrinsic :: ieee_arithmetic -private -! !PUBLIC MEMBER FUNCTIONS: + implicit none -public :: SetServices -! -!EOP -! -integer, parameter :: NUM_SUBTILES = 4 -integer :: NUM_ENSEMBLE -integer :: FIRST_ENS_ID -integer :: collect_tb_counter - -type(met_force_type), allocatable :: mfPert_ensavg(:) - -type(obs_param_type),pointer :: obs_param(:)=>null() -logical :: need_mwRTM_param -! RRTBHISTORY: I DID NOT SEE WHERE need_mwRTM_param WAS INITIALIZED. SHOULD BE INITIALIZED TO .false. ?? -! CAN WE CHECK IF HISTORY REQUESTS Tb OUTPUT AND CHANGE need_mwRTM_param TO .true. ACCODINGLY ?? -! THIS MIGHT REQUIRE MORE DISCUSSION -integer :: update_type, dtstep_assim -logical :: centered_update -real :: xcompact, ycompact -real :: fcsterr_inflation_fac -integer :: N_obs_param -logical :: out_obslog -logical :: out_ObsFcstAna -logical :: out_smapL4SMaup -integer :: N_obsbias_max - -integer,dimension(:),pointer :: N_catl_vec,low_ind -integer :: N_catf -!reordered tile_coord_rf and mapping l2rf -integer,dimension(:),pointer :: l2rf, rf2l,rf2g, rf2f -type(tile_coord_type), dimension(:), pointer :: tile_coord_rf => null() -integer, allocatable :: Pert_rseed(:,:) -real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) -type(mwRTM_param_type),dimension(:),allocatable :: mwRTM_param -logical :: all_nodata ! no data for mwRTM_param -logical :: land_assim -logical :: mwRTM -contains + include 'mpif.h' + + private + + ! !PUBLIC MEMBER FUNCTIONS: + + public :: SetServices + ! + !EOP + ! + integer, parameter :: NUM_SUBTILES = 4 + integer :: NUM_ENSEMBLE + integer :: FIRST_ENS_ID + integer :: collect_tb_counter + + type(met_force_type), allocatable :: mfPert_ensavg(:) + + type(obs_param_type), pointer :: obs_param(:)=>null() + + integer :: update_type, dtstep_assim + logical :: centered_update + real :: xcompact, ycompact + real :: fcsterr_inflation_fac + integer :: N_obs_param + logical :: out_obslog + logical :: out_ObsFcstAna + logical :: out_smapL4SMaup + integer :: N_obsbias_max + + integer, dimension(:), pointer :: N_catl_vec,low_ind + integer :: N_catf -!BOP -! !IROUTINE: SetServices -- Sets ESMF services for component -! !INTERFACE: + !reordered tile_coord_rf and mapping l2rf + integer, dimension(:), pointer :: l2rf, rf2l,rf2g, rf2f + type(tile_coord_type), dimension(:), pointer :: tile_coord_rf => null() -subroutine SetServices ( GC, RC ) + integer, allocatable :: Pert_rseed(:,:) + real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) + type(mwRTM_param_type), dimension(:), allocatable :: mwRTM_param -! !ARGUMENTS: + logical :: mwRTM_all_nodata ! no data for mwRTM_param + logical :: land_assim + logical :: mwRTM +contains + + !BOP + ! !IROUTINE: SetServices -- Sets ESMF services for component + ! !INTERFACE: + + subroutine SetServices ( GC, RC ) + + ! !ARGUMENTS: + type(ESMF_GridComp),intent(INOUT) :: GC integer, optional, intent( OUT) :: RC - -! !DESCRIPTION: - -!EOP -! -! ErrLog Variables - - character(len=ESMF_MAXSTR) :: Iam - character(len=ESMF_MAXSTR) :: COMP_NAME - integer :: STATUS - -! Local Variables + + ! !DESCRIPTION: + + !EOP + ! + ! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + + ! Local Variables type(MAPL_MetaComp), pointer :: MAPL=>null() - type(ESMF_Config) :: CF -! Begin... -! -------- - -! Get my name and set-up traceback handle -! ------------------------------------------------------------------------------ + type(ESMF_Config) :: CF + ! Begin... + ! -------- + + ! Get my name and set-up traceback handle + ! ------------------------------------------------------------------------------ + Iam='SetServices' call ESMF_GridCompGet ( GC, NAME=COMP_NAME, RC=STATUS ) _VERIFY(STATUS) Iam=trim(COMP_NAME)//trim(Iam) - + call MAPL_GetObjectFromGC(gc, MAPL, rc=status) _VERIFY(status) - + call MAPL_GetResource ( MAPL, land_assim, Label="LAND_ASSIM:", DEFAULT = .false., RC=STATUS) VERIFY_(STATUS) call MAPL_GetResource ( MAPL, mwRTM, Label="mwRTM:", DEFAULT = .false., RC=STATUS) VERIFY_(STATUS) - - ! Register services for this component + + ! Register services for this component call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_INITIALIZE, & @@ -165,7 +163,7 @@ subroutine SetServices ( GC, RC ) rc=status & ) _VERIFY(status) - + !phase 1: assimilation run call MAPL_GridCompSetEntryPoint( & gc, & @@ -174,7 +172,7 @@ subroutine SetServices ( GC, RC ) rc=status & ) _VERIFY(status) - + !phase 2: feed back to change catch_progn call MAPL_GridCompSetEntryPoint( & gc, & @@ -183,8 +181,8 @@ subroutine SetServices ( GC, RC ) rc=status & ) _VERIFY(status) - - !phase 3: calculation of L-band Tb_h and Tb_v for each ensemble member + + !phase 3: calculation of ensemble average of L-band Tb_h and Tb_v call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & @@ -192,7 +190,7 @@ subroutine SetServices ( GC, RC ) rc=status & ) _VERIFY(status) - + call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_FINALIZE, & @@ -200,294 +198,293 @@ subroutine SetServices ( GC, RC ) rc=status & ) _VERIFY(status) - - - -! Set the state variable specs. -! ----------------------------- -!BOS -! -! IMPORT STATE: -! -! --------------------------------- - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'soil_porosity' ,& - UNITS = '1' ,& - SHORT_NAME = 'POROS' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'sfc_sat_hydraulic_conduct' ,& - UNITS = 'm s-1' ,& - SHORT_NAME = 'COND' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'saturated_matric_potential',& - UNITS = 'm' ,& - SHORT_NAME = 'PSIS' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'clapp_hornberger_b' ,& - UNITS = '1' ,& - SHORT_NAME = 'BEE' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'wetness_at_wilting_point' ,& - UNITS = '1' ,& - SHORT_NAME = 'WPWET' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'vertical_transmissivity' ,& - UNITS = 'm-1' ,& - SHORT_NAME = 'GNU' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'max_rootzone_water_content',& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'VGWMAX' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'topo_baseflow_param_1' ,& - UNITS = 'kg m-4' ,& - SHORT_NAME = 'BF1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'topo_baseflow_param_2' ,& - UNITS = 'm' ,& - SHORT_NAME = 'BF2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'topo_baseflow_param_3' ,& - UNITS = 'log(m)' ,& - SHORT_NAME = 'BF3' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'moisture_threshold' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'CDCR1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'max_water_content' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'CDCR2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'wetness_param_1' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARS1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'wetness_param_2' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARS2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'wetness_param_3' ,& - UNITS = 'm+4 kg-2' ,& - SHORT_NAME = 'ARS3' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'shape_param_1' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARA1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'shape_param_2' ,& - UNITS = '1' ,& - SHORT_NAME = 'ARA2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'shape_param_3' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARA3' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'shape_param_4' ,& - UNITS = '1' ,& - SHORT_NAME = 'ARA4' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'min_theta_param_1' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARW1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'min_theta_param_2' ,& - UNITS = 'm+2 kg-1' ,& - SHORT_NAME = 'ARW2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'min_theta_param_3' ,& - UNITS = 'm+4 kg-2' ,& - SHORT_NAME = 'ARW3' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'min_theta_param_4' ,& - UNITS = '1' ,& - SHORT_NAME = 'ARW4' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_1' ,& - UNITS = '1' ,& - SHORT_NAME = 'TSA1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_2' ,& - UNITS = '1' ,& - SHORT_NAME = 'TSA2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_3' ,& - UNITS = '1' ,& - SHORT_NAME = 'TSB1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_4' ,& - UNITS = '1' ,& - SHORT_NAME = 'TSB2' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_5' ,& - UNITS = '1' ,& - SHORT_NAME = 'ATAU' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - LONG_NAME = 'water_transfer_param_6' ,& - UNITS = '1' ,& - SHORT_NAME = 'BTAU' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'ITY' ,& - LONG_NAME = 'vegetation_type' ,& - UNITS = '1' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - - call MAPL_AddImportSpec(GC ,& - SHORT_NAME = 'Z2CH' ,& - LONG_NAME = 'vegetation_height' ,& - UNITS = 'm' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - + + + ! Set the state variable specs. + ! ----------------------------- + !BOS + ! + ! IMPORT STATE: + ! + ! --------------------------------- + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'soil_porosity' ,& + UNITS = '1' ,& + SHORT_NAME = 'POROS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'sfc_sat_hydraulic_conduct' ,& + UNITS = 'm s-1' ,& + SHORT_NAME = 'COND' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'saturated_matric_potential',& + UNITS = 'm' ,& + SHORT_NAME = 'PSIS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'clapp_hornberger_b' ,& + UNITS = '1' ,& + SHORT_NAME = 'BEE' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'wetness_at_wilting_point' ,& + UNITS = '1' ,& + SHORT_NAME = 'WPWET' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'vertical_transmissivity' ,& + UNITS = 'm-1' ,& + SHORT_NAME = 'GNU' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'max_rootzone_water_content',& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'VGWMAX' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_1' ,& + UNITS = 'kg m-4' ,& + SHORT_NAME = 'BF1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_2' ,& + UNITS = 'm' ,& + SHORT_NAME = 'BF2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'topo_baseflow_param_3' ,& + UNITS = 'log(m)' ,& + SHORT_NAME = 'BF3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'moisture_threshold' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CDCR1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'max_water_content' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CDCR2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'wetness_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARS1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'wetness_param_2' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARS2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'wetness_param_3' ,& + UNITS = 'm+4 kg-2' ,& + SHORT_NAME = 'ARS3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'shape_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARA1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'shape_param_2' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARA2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'shape_param_3' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARA3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'shape_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARA4' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'min_theta_param_1' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARW1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'min_theta_param_2' ,& + UNITS = 'm+2 kg-1' ,& + SHORT_NAME = 'ARW2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'min_theta_param_3' ,& + UNITS = 'm+4 kg-2' ,& + SHORT_NAME = 'ARW3' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'min_theta_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'ARW4' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_1' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSA1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_2' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSA2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_3' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSB1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_4' ,& + UNITS = '1' ,& + SHORT_NAME = 'TSB2' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_5' ,& + UNITS = '1' ,& + SHORT_NAME = 'ATAU' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + LONG_NAME = 'water_transfer_param_6' ,& + UNITS = '1' ,& + SHORT_NAME = 'BTAU' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'ITY' ,& + LONG_NAME = 'vegetation_type' ,& + UNITS = '1' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddImportSpec(GC ,& + SHORT_NAME = 'Z2CH' ,& + LONG_NAME = 'vegetation_height' ,& + UNITS = 'm' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + ! Exports for brightness temperature @@ -509,293 +506,273 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) _VERIFY(STATUS) - ! Exports for incr - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_temperature_saturated_zone' ,& - UNITS = 'K' ,& - SHORT_NAME = 'TCFSAT_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + ! Exports for Catchment prognostics increments + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_saturated_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFSAT_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_temperature_transition_zone' ,& - UNITS = 'K' ,& - SHORT_NAME = 'TCFTRN_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_transition_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFTRN_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_temperature_wilting_zone' ,& + UNITS = 'K' ,& + SHORT_NAME = 'TCFWLT_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_temperature_wilting_zone' ,& - UNITS = 'K' ,& - SHORT_NAME = 'TCFWLT_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFSAT_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_specific_humidity_saturated_zone' ,& - UNITS = 'kg kg-1' ,& - SHORT_NAME = 'QCFSAT_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_transition_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFTRN_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_specific_humidity_transition_zone' ,& - UNITS = 'kg kg-1' ,& - SHORT_NAME = 'QCFTRN_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone' ,& + UNITS = 'kg kg-1' ,& + SHORT_NAME = 'QCFWLT_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_canopy_specific_humidity_wilting_zone' ,& - UNITS = 'kg kg-1' ,& - SHORT_NAME = 'QCFWLT_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_interception_reservoir_capac' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CAPAC_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_interception_reservoir_capac',& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'CAPAC_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_catchment_deficit' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'CATDEF_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_catchment_deficit' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'CATDEF_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_root_zone_excess' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'RZEXC_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_root_zone_excess' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'RZEXC_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_surface_excess' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'SRFEXC_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_surface_excess' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'SRFEXC_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_1' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT1_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_1' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT1_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_2' ,& + UNITS = 'J_m-2' ,& + SHORT_NAME = 'GHTCNT2_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_2' ,& - UNITS = 'J_m-2' ,& - SHORT_NAME = 'GHTCNT2_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_3' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT3_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_3' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT3_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_4' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT4_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_4' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT4_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_5' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT5_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_5' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT5_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_soil_heat_content_layer_6' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'GHTCNT6_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_soil_heat_content_layer_6' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'GHTCNT6_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_1' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN1_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_mass_layer_1' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'WESNN1_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_2' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN2_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_mass_layer_2' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'WESNN2_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_mass_layer_3' ,& + UNITS = 'kg m-2' ,& + SHORT_NAME = 'WESNN3_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_mass_layer_3' ,& - UNITS = 'kg m-2' ,& - SHORT_NAME = 'WESNN3_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_1' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN1_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_heat_content_snow_layer_1' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'HTSNNN1_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_2' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN2_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_heat_content_snow_layer_2' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'HTSNNN2_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_heat_content_snow_layer_3' ,& + UNITS = 'J m-2' ,& + SHORT_NAME = 'HTSNNN3_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_heat_content_snow_layer_3' ,& - UNITS = 'J m-2' ,& - SHORT_NAME = 'HTSNNN3_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_1' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN1_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_depth_layer_1' ,& - UNITS = 'm' ,& - SHORT_NAME = 'SNDZN1_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_2' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN2_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_depth_layer_2' ,& - UNITS = 'm' ,& - SHORT_NAME = 'SNDZN2_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) - _VERIFY(STATUS) - call MAPL_AddExportSpec(GC ,& - LONG_NAME = 'increment_snow_depth_layer_3' ,& - UNITS = 'm' ,& - SHORT_NAME = 'SNDZN3_INCR' ,& -! FRIENDLYTO = trim(COMP_NAME) ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& - RC=STATUS ) + call MAPL_AddExportSpec(GC ,& + LONG_NAME = 'increment_snow_depth_layer_3' ,& + UNITS = 'm' ,& + SHORT_NAME = 'SNDZN3_INCR' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& + RC=STATUS ) _VERIFY(STATUS) + -! -! INTERNAL STATE -! - call MAPL_AddInternalSpec(GC ,& + ! + ! INTERNAL STATE + ! + + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Vegetation class. Type is Unsigned32' ,& - UNITS = '1' ,& - SHORT_NAME = 'MWRTM_VEGCLS' ,& - DIMS = MAPL_DimsTileOnly ,& - VLOCATION = MAPL_VLocationNone ,& + UNITS = '1' ,& + SHORT_NAME = 'MWRTM_VEGCLS' ,& + DIMS = MAPL_DimsTileOnly ,& + VLOCATION = MAPL_VLocationNone ,& FRIENDLYTO = trim(COMP_NAME) ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Soil class. Type is Unsigned32' ,& UNITS = '1' ,& SHORT_NAME = 'MWRTM_SOILCLS' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Sand fraction' ,& UNITS = '1' ,& SHORT_NAME = 'MWRTM_SAND' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Clay fraction' ,& UNITS = '1' ,& SHORT_NAME = 'MWRTM_CLAY' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -804,7 +781,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_POROS' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -813,7 +790,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_WANGWT' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -822,7 +799,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_WANGWP' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -831,7 +808,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHHMIN' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -840,25 +817,25 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHHMAX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Soil moisture value below which maximum microwave roughness parameter is used' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'MWRTM_RGHWMIN' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic , & + DEFAULT = nodata_generic ,& RC=STATUS) - call MAPL_AddInternalSpec(GC ,& + call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'L-band Microwave RTM: Soil moisture value above which minimum microwave roughness parameter is used' ,& UNITS = 'm3 m-3' ,& SHORT_NAME = 'MWRTM_RGHWMAX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -867,7 +844,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHNRH' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -876,7 +853,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHNRV' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -885,7 +862,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_RGHPOLMIX' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -894,7 +871,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_OMEGA' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -903,7 +880,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_BH' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -912,7 +889,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_BV' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_AddInternalSpec(GC ,& @@ -921,7 +898,7 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'MWRTM_LEWT' ,& DIMS = MAPL_DimsTileOnly ,& VLOCATION = MAPL_VLocationNone ,& - DEFAULT = nodata_generic ,& + DEFAULT = nodata_generic ,& RC=STATUS) call MAPL_TimerAdd(GC, name="Initialize" ,RC=STATUS) @@ -931,49 +908,49 @@ subroutine SetServices ( GC, RC ) call MAPL_GenericSetServices ( GC, RC=STATUS ) _VERIFY(STATUS) - + RETURN_(ESMF_SUCCESS) - -end subroutine SetServices - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!BOP -! !IROTUINE: Initialize -- initialize method for LandAssim GC - -! !INTERFACE: -subroutine Initialize(gc, import, export, clock, rc) - + + end subroutine SetServices + + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !BOP + ! !IROTUINE: Initialize -- initialize method for LandAssim GC + + ! !INTERFACE: + subroutine Initialize(gc, import, export, clock, rc) + ! !ARGUMENTS: - + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component type(ESMF_State), intent(inout) :: import ! Import state type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code - + integer :: status - character(len=ESMF_MAXSTR) :: Iam - character(len=ESMF_MAXSTR) :: comp_name - - ! ESMF variables - type(ESMF_Time) :: CurrentTime - type(ESMF_Alarm) :: LandAssimAlarm - type(ESMF_TimeInterval) :: LandAssim_DT - integer :: LandAssimDTstep - type(ESMF_TimeInterval) :: ModelTimeStep + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: comp_name + + ! ESMF variables + type(ESMF_Time) :: CurrentTime + type(ESMF_Alarm) :: LandAssimAlarm + type(ESMF_TimeInterval) :: LandAssim_DT + integer :: LandAssimDTstep + type(ESMF_TimeInterval) :: ModelTimeStep ! locals type(MAPL_MetaComp), pointer :: MAPL=>null() - type(MAPL_LocStream) :: locstream + type(MAPL_LocStream) :: locstream - character(len=300) :: out_path,fname - character(len=ESMF_MAXSTR) :: exp_id, GridName - integer :: model_dtstep - type(date_time_type) :: start_time + character(len=300) :: out_path,fname + character(len=ESMF_MAXSTR) :: exp_id, GridName + integer :: model_dtstep + type(date_time_type) :: start_time - ! LDAS' tile_coord variable + ! LDAS' tile_coord variable type(T_TILECOORD_STATE), pointer :: tcinternal - type(TILECOORD_WRAP) :: tcwrap + type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), dimension(:), pointer :: tile_coord_f => null() type(tile_coord_type), dimension(:), pointer :: tile_coord_l => null() @@ -981,20 +958,19 @@ subroutine Initialize(gc, import, export, clock, rc) integer :: land_nt_local,i,mpierr, ens ! mapping f to re-orderd f so it is continous for mpi_gather ! rf -- ordered by processors. Within the processor, ordered by MAPL grid - integer,allocatable :: f2rf(:) ! mapping re-orderd rf to f for the LDASsa output - type(grid_def_type) :: tile_grid_g - type(grid_def_type) :: tile_grid_f - character(len=300) :: seed_fname - character(len=300) :: fname_tpl - character(len=14) :: datestamp - character(len=4) :: id_string - integer :: nymd, nhms - - -!! from LDASsa + integer, allocatable :: f2rf(:) ! mapping re-orderd rf to f for the LDASsa output + type(grid_def_type) :: tile_grid_g + type(grid_def_type) :: tile_grid_f + character(len=300) :: seed_fname + character(len=300) :: fname_tpl + character(len=14) :: datestamp + character(len=4) :: id_string + integer :: nymd, nhms + !! from LDASsa + ! Begin... - + ! Get component's name and setup traceback handle call ESMF_GridCompget(gc, name=comp_name, rc=status) _VERIFY(status) @@ -1002,11 +978,11 @@ subroutine Initialize(gc, import, export, clock, rc) ! Get MAPL obj call MAPL_GetObjectFromGC(gc, MAPL, rc=status) _VERIFY(status) - + ! Turn timers on call MAPL_TimerOn(MAPL, "TOTAL") call MAPL_TimerOn(MAPL, "Initialize") - + collect_tb_counter = 0 call MAPL_GetResource ( MAPL, NUM_ENSEMBLE, Label="NUM_LDAS_ENSEMBLE:", DEFAULT=1, RC=STATUS) _VERIFY(STATUS) @@ -1014,47 +990,50 @@ subroutine Initialize(gc, import, export, clock, rc) _VERIFY(STATUS) call init_log( myid, numprocs, master_proc ) - if ( .not. land_assim) then - ! to arrive here, mwRTM must be .true. - call MAPL_GenericInitialize(gc, import, export, clock, rc=status) - _VERIFY(status) - - call MAPL_TimerOff(MAPL, "Initialize") - call MAPL_TimerOff(MAPL, "TOTAL") - RETURN_(ESMF_SUCCESS) + if ( .not. land_assim) then ! to arrive here, mwRTM must be .true. + + ! only need to calculate Tb for HISTORY; no processing of assimilation obs necessary; + ! generic initialization is sufficient + + call MAPL_GenericInitialize(gc, import, export, clock, rc=status) + _VERIFY(status) + + call MAPL_TimerOff(MAPL, "Initialize") + call MAPL_TimerOff(MAPL, "TOTAL") + RETURN_(ESMF_SUCCESS) endif - + call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) _VERIFY(STATUS) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) _VERIFY(STATUS) - + ! Get current time call ESMF_ClockGet(clock, currTime=CurrentTime, rc=status) _VERIFY(status) call esmf2ldas(CurrentTime, start_time, rc=status) _VERIFY(status) - + call ESMF_ClockGet(clock, timeStep=ModelTimeStep,rc=status) _VERIFY(status) call ESMF_TimeIntervalGet(ModelTimeStep, s=model_dtstep,rc=status) _VERIFY(status) - + ! Create alarm for Land assimilation ! -create-nonsticky-alarm- - ! -time-interval- + ! -time-interval- call MAPL_GetResource( & MAPL, & - LandAssimDtStep, & - 'LANDASSIM_DTSTEP:', & - default=10800, & + LandAssimDtStep, & + 'LANDASSIM_DTSTEP:', & + default=10800, & rc=status & ) _VERIFY(status) - + call ESMF_TimeIntervalSet(LandAssim_DT, s=LandAssimDtStep, rc=status) _VERIFY(status) - + LandAssimAlarm = ESMF_AlarmCreate( & clock, & name='LandAssim', & @@ -1070,17 +1049,17 @@ subroutine Initialize(gc, import, export, clock, rc) _VERIFY(status) tcinternal =>tcwrap%ptr tile_coord_l =>tcinternal%tile_coord - ! Get number of land tiles + ! Get number of land tiles call MAPL_Get(MAPL, LocStream=locstream,rc=status) _VERIFY(status) call MAPL_LocStreamGet(locstream, NT_LOCAL=land_nt_local,rc=status) _VERIFY(status) - + allocate(Pert_rseed(NRANDSEED, NUM_ENSEMBLE), source = 0) allocate(Pert_rseed_r8(NRANDSEED, NUM_ENSEMBLE), source = 0.0d0) - + if (master_proc) then - + call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_RESTART_FILE:", DEFAULT="../intput/restart/landassim_obspertrseed%s_rst", RC=STATUS) _VERIFY(STATUS) call MAPL_DateStampGet( clock, datestamp, rc=status) @@ -1089,27 +1068,27 @@ subroutine Initialize(gc, import, export, clock, rc) read(datestamp(10:13),*) nhms nhms = nhms*100 do ens = 0, NUM_ENSEMBLE-1 - write(id_string,'(I4.4)') ens + FIRST_ENS_ID - seed_fname = "" - call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) - call read_pert_rseed(seed_fname,Pert_rseed_r8(:,ens+1)) - - Pert_rseed(:,ens+1) = nint(Pert_rseed_r8(:,ens+1)) - if (all(Pert_rseed(:,ens+1) == 0)) then - call get_init_pert_rseed(ens, pert_rseed(1,ens+1)) - call init_randseed(pert_rseed(:,ens+1)) - endif + write(id_string,'(I4.4)') ens + FIRST_ENS_ID + seed_fname = "" + call ESMF_CFIOStrTemplate(seed_fname,fname_tpl,'GRADS', xid=id_string,nymd=nymd,nhms=nhms,stat=status) + call read_pert_rseed(seed_fname,Pert_rseed_r8(:,ens+1)) + + Pert_rseed(:,ens+1) = nint(Pert_rseed_r8(:,ens+1)) + if (all(Pert_rseed(:,ens+1) == 0)) then + call get_init_pert_rseed(ens, pert_rseed(1,ens+1)) + call init_randseed(pert_rseed(:,ens+1)) + endif enddo endif call MPI_Bcast(pert_rseed, NRANDSEED*NUM_ENSEMBLE, MPI_INTEGER, 0, mpicomm, mpierr) - - + + allocate(N_catl_vec(numprocs)) allocate(low_ind(numprocs)) allocate(l2rf(land_nt_local)) - + call MPI_AllGATHER(land_nt_local,1,MPI_INTEGER,N_catl_vec,1,MPI_INTEGER,mpicomm,mpierr) - + low_ind(1) = 1 do i = 2, numprocs low_ind(i) = low_ind(i-1) + N_catl_vec(i-1) @@ -1119,63 +1098,63 @@ subroutine Initialize(gc, import, export, clock, rc) allocate(f2rf(N_catf)) call MPI_AllGATHERV(tcinternal%l2f, land_nt_local, MPI_INTEGER, & - rf2f, N_catl_vec, low_ind-1, MPI_INTEGER, & - mpicomm,mpierr) - + rf2f, N_catl_vec, low_ind-1, MPI_INTEGER, & + mpicomm,mpierr) + allocate(tile_coord_rf(N_catf)) tile_coord_rf(:) = tcwrap%ptr%tile_coord_f(rf2f(:)) allocate(rf2g(N_catf)) rf2g(:) = tile_coord_rf(:)%tile_id - + do i=1,N_catf - f2rf(rf2f(i))= i - tile_coord_rf(i)%f_num = i + f2rf(rf2f(i))= i + tile_coord_rf(i)%f_num = i enddo - + do i=1, land_nt_local l2rf(i) = low_ind(myid+1) + i - 1 end do - + tcwrap%ptr%tile_coord%f_num = l2rf - - ! invert mapping from local to full grid (get f2l from l2f) - + + ! invert mapping from local to full grid (get f2l from l2f) + allocate(rf2l(N_catf)) - + rf2l = -9999 - + do i=1,land_nt_local - rf2l( l2rf(i) ) = i + rf2l( l2rf(i) ) = i end do if (master_proc) then - call read_ens_upd_inputs( & - trim(out_path), & - trim(exp_id), & - start_time, & - model_dtstep, & - N_catf, tile_coord_rf, & - N_progn_pert, progn_pert_param, & - N_force_pert, force_pert_param, & - need_mwRTM_param, & ! RRTBHISTORY: need_mwRTM_param=.true. WHEN Tb OBS ARE ASSIMILATED - update_type, & - dtstep_assim, & - centered_update, & - xcompact, ycompact, & - fcsterr_inflation_fac, & - N_obs_param, & - obs_param, & - out_obslog, & - out_ObsFcstAna, & - out_smapL4SMaup, & - N_obsbias_max & - ) - call MAPL_GetResource ( MAPL, GridName, Label="GEOSldas.GRIDNAME:", DEFAULT="EASE", RC=STATUS) - _VERIFY(STATUS) - if (index(GridName,"-CF") /=0) out_smapL4SMaup = .false. ! no out_smap for now if it is cs frid + call read_ens_upd_inputs( & + trim(out_path), & + trim(exp_id), & + start_time, & + model_dtstep, & + N_catf, tile_coord_rf, & + N_progn_pert, progn_pert_param, & + N_force_pert, force_pert_param, & + mwRTM, & ! ensure mwRTM=.true. when microwave Tb obs are assimilated + update_type, & + dtstep_assim, & + centered_update, & + xcompact, ycompact, & + fcsterr_inflation_fac, & + N_obs_param, & + obs_param, & + out_obslog, & + out_ObsFcstAna, & + out_smapL4SMaup, & + N_obsbias_max & + ) + call MAPL_GetResource ( MAPL, GridName, Label="GEOSldas.GRIDNAME:", DEFAULT="EASE", RC=STATUS) + _VERIFY(STATUS) + if (index(GridName,"-CF") /=0) out_smapL4SMaup = .false. ! no out_smap for now if it is cs frid endif - - call MPI_BCAST(need_mwRTM_param, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) + + call MPI_BCAST(mwRTM, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(update_type, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(dtstep_assim, 1, MPI_INTEGER, 0,MPICOMM,mpierr) call MPI_BCAST(centered_update, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) @@ -1187,84 +1166,88 @@ subroutine Initialize(gc, import, export, clock, rc) call MPI_BCAST(out_ObsFcstAna, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(out_smapL4SMaup, 1, MPI_LOGICAL, 0,MPICOMM,mpierr) call MPI_BCAST(N_obsbias_max, 1, MPI_INTEGER, 0,MPICOMM,mpierr) - - if (.not. master_proc) allocate(obs_param(N_obs_param)) - + + if (.not. master_proc) allocate(obs_param(N_obs_param)) + call MPI_BCAST(obs_param, N_obs_param, MPI_OBS_PARAM_TYPE, 0,MPICOMM,mpierr) - + if (master_proc) call echo_clsm_ensupd_glob_param(logunit) - + call MAPL_GenericInitialize(gc, import, export, clock, rc=status) _VERIFY(status) - + call MAPL_TimerOff(MAPL, "Initialize") call MAPL_TimerOff(MAPL, "TOTAL") - + RETURN_(ESMF_SUCCESS) - -end subroutine Initialize - -! !IROUTINE: RUN -! !INTERFACE: -subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) - -! !ARGUMENTS: - + + end subroutine Initialize + + ! !IROUTINE: RUN + ! !INTERFACE: + subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) + + ! !ARGUMENTS: + type(ESMF_GridComp),intent(inout) :: GC !Gridded component type(ESMF_State), intent(inout) :: IMPORT !Import state type(ESMF_State), intent(inout) :: EXPORT !Export state type(ESMF_Clock), intent(inout) :: CLOCK !The clock integer,optional, intent(out ) :: RC !Error code: + + !EOP + ! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + ! + ! time + ! + type(ESMF_Time) :: ModelTimeCur, ModelTimeNxt + type(ESMF_Alarm) :: LandAssimAlarm + type(ESMF_TimeInterval) :: ModelTimeStep + + + ! Locals + type(MAPL_MetaComp), pointer :: MAPL=>null() + type(TILECOORD_WRAP) :: tcwrap + type(tile_coord_type), pointer :: tile_coord_l(:)=>null() + type(T_TILECOORD_STATE), pointer :: tcinternal -!EOP -! ErrLog Variables + type(ESMF_State) :: INTERNAL + type(date_time_type) :: start_time + type(date_time_type) :: date_time_new + character(len=14) :: datestamp - character(len=ESMF_MAXSTR) :: IAm - integer :: STATUS - character(len=ESMF_MAXSTR) :: COMP_NAME -! -! time -! - type(ESMF_Time) :: ModelTimeCur, ModelTimeNxt - type(ESMF_Alarm) :: LandAssimAlarm - type(ESMF_TimeInterval) :: ModelTimeStep + integer :: N_catl, N_catg,N_obsl_max, n_e, i + character(len=300) :: out_path + character(len=ESMF_MAXSTR) :: exp_id + character(40) :: exp_domain + integer :: model_dtstep -! Locals - type(MAPL_MetaComp), pointer :: MAPL=>null() - type(TILECOORD_WRAP) :: tcwrap - type(tile_coord_type), pointer :: tile_coord_l(:)=>null() - type(T_TILECOORD_STATE), pointer :: tcinternal + type(met_force_type), dimension(:), allocatable :: met_force - type(ESMF_State) :: INTERNAL - type(date_time_type) :: start_time - type(date_time_type) :: date_time_new - character(len=14) :: datestamp + integer :: N_adapt_R + type(MAPL_LocStream) :: locstream - integer :: N_catl, N_catg,N_obsl_max, n_e, i + integer, dimension(:), allocatable :: obs_pert_adapt_param + real, dimension(:,:), allocatable :: Pert_adapt_R + real, dimension(:,:), allocatable :: Obs_pert + type(obs_bias_type), dimension(:,:,:), allocatable :: obs_bias - character(len=300) :: out_path - character(len=ESMF_MAXSTR) :: exp_id - character(40) :: exp_domain - integer :: model_dtstep - type(met_force_type), dimension(:), allocatable :: met_force + type(cat_progn_type), dimension(:,:), allocatable :: cat_progn_incr + type(cat_progn_type), dimension(:), allocatable :: cat_progn_incr_ensavg + + type(obs_type), dimension(:), pointer :: Observations_l => null() - integer :: N_adapt_R - type(MAPL_LocStream) :: locstream - integer,dimension(:),allocatable :: obs_pert_adapt_param - real,dimension(:,:), allocatable :: Pert_adapt_R - real,dimension(:,:), allocatable :: Obs_pert - type(obs_bias_type), dimension(:,:,:), allocatable :: obs_bias - - type(cat_progn_type), dimension(:,:), allocatable :: cat_progn_incr - type(cat_progn_type), dimension(:), allocatable :: cat_progn_incr_ensavg - type(obs_type), dimension(:), pointer :: Observations_l => null() logical :: fresh_incr integer :: N_obsf,N_obsl integer :: secs_in_day -!! import ensemble forcing - + !! import ensemble forcing + real, pointer :: TA_enavg(:)=>null() real, pointer :: QA_enavg(:)=>null() real, pointer :: PS_enavg(:)=>null() @@ -1283,8 +1266,8 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer :: SWLAND(:)=>null() real, pointer :: LAI(:)=>null() -!! export incr progn - + !! export incr progn + real, dimension(:),pointer :: TC1_incr=>null() real, dimension(:),pointer :: TC2_incr=>null() real, dimension(:),pointer :: TC4_incr=>null() @@ -1312,53 +1295,53 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) real, dimension(:),pointer :: SNDZN3_incr=>null() - logical :: spin + logical :: spin logical, save :: firsttime=.true. type(cat_bias_param_type) :: cat_bias_param integer :: N_catbias - character(len=300) :: seed_fname - character(len=300) :: fname_tpl - character(len=4) :: id_string - integer:: ens, nymd, nhms + character(len=300) :: seed_fname + character(len=300) :: fname_tpl + character(len=4) :: id_string + integer :: ens, nymd, nhms #ifdef DBG_LANDASSIM_INPUTS - ! vars for debugging purposes - type(ESMF_Grid) :: TILEGRID - integer, pointer :: mask(:) - integer :: nt,ens_id - integer, save :: unit_i=0 - integer :: unit - integer :: NT_GLOBAL,mpierr,i - real,allocatable :: metTair(:),metTair_l(:) - integer,allocatable :: ids(:) + ! vars for debugging purposes + type(ESMF_Grid) :: TILEGRID + integer, pointer :: mask(:) + integer :: nt,ens_id + integer, save :: unit_i=0 + integer :: unit + integer :: NT_GLOBAL,mpierr,i + real, allocatable :: metTair(:),metTair_l(:) + integer, allocatable :: ids(:) #endif - + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) _VERIFY(STATUS) Iam=trim(COMP_NAME)//"::RUN" - + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) _VERIFY(STATUS) -! Start timers -! ------------ + ! Start timers + ! ------------ call MAPL_TimerOn(MAPL,"TOTAL") call MAPL_TimerOn(MAPL,"RUN") call ESMF_ClockGetAlarm(clock, 'LandAssim', LandAssimAlarm, rc=status) _VERIFY(status) - + call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) - - ! Get component's internal variable + + ! Get component's internal variable call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) _VERIFY(status) tcinternal => tcwrap%ptr tile_coord_l => tcwrap%ptr%tile_coord - + call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) _VERIFY(status) - + ! Get current time call ESMF_ClockGet(clock, timeStep=ModelTimeStep,rc=status) _VERIFY(status) @@ -1366,35 +1349,39 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(status) call esmf2ldas(ModelTimeCur+ModelTimeStep, date_time_new, rc=status) _VERIFY(status) - + call esmf2ldas(ModelTimeCur, start_time, rc=status) _VERIFY(status) - + ! Get number of land tiles call MAPL_Get(MAPL, LocStream=locstream,rc=status) _VERIFY(status) call MAPL_LocStreamGet(locstream, NT_LOCAL=N_catl,rc=status) _VERIFY(status) - -! Pointers to internals -!---------------------- - if (need_mwRTM_param) then + + ! Pointers to internals + !---------------------- + if (mwRTM) then call get_mwrtm_param(INTERNAL, N_catl, rc=STATUS) _VERIFY(STATUS) endif - + ! assert mwRTM parameters are not nodata for all tiles + if (mwRTM_all_nodata) then + _ASSERT(.false., "Tb innovations or assimilation requested but all mwRTM parameters are nodata") + endif + if (firsttime) then firsttime = .false. - if (need_mwRTM_param) & - call GEOS_output_smapL4SMlmc( GC, start_time, trim(out_path), trim(exp_id), & - N_catl, tile_coord_l, cat_param, mwRTM_param ) + if (mwRTM) & + call GEOS_output_smapL4SMlmc( GC, start_time, trim(out_path), trim(exp_id), & + N_catl, tile_coord_l, cat_param, mwRTM_param ) if (master_proc) then - ! for out put + ! for out put call read_cat_bias_inputs( trim(out_path), trim(exp_id), start_time, update_type, & - cat_bias_param, N_catbias) + cat_bias_param, N_catbias) endif endif - + ! The time is one model time step behind Current time, so record the checkpoint here if (MAPL_RecordAlarmIsRinging(MAPL)) then if (master_proc) then @@ -1414,106 +1401,106 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) call write_pert_rseed(trim(seed_fname), Pert_rseed_r8(:,ens+1)) enddo - endif + endif endif - - + + if ( .not. ESMF_AlarmIsRinging(LandAssimAlarm)) then call MAPL_TimerOff ( MAPL, "RUN" ) call MAPL_TimerOff ( MAPL, "TOTAL" ) RETURN_(ESMF_SUCCESS) endif - + N_obsl_max = N_catl*N_obs_param - -!! get import from ens to get ensemble average forcing - - call MAPL_GetPointer(import, TA_enavg, 'TA', rc=status) + + !! get import from ens to get ensemble average forcing + + call MAPL_GetPointer(import, TA_enavg, 'TA', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, QA_enavg, 'QA', rc=status) + call MAPL_GetPointer(import, QA_enavg, 'QA', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, PS_enavg, 'PS', rc=status) + call MAPL_GetPointer(import, PS_enavg, 'PS', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, UU_enavg, 'UU', rc=status) + call MAPL_GetPointer(import, UU_enavg, 'UU', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, PCU_enavg, 'PCU', rc=status) + call MAPL_GetPointer(import, PCU_enavg, 'PCU', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, PLS_enavg, 'PLS', rc=status) + call MAPL_GetPointer(import, PLS_enavg, 'PLS', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, SNO_enavg, 'SNO', rc=status) + call MAPL_GetPointer(import, SNO_enavg, 'SNO', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, DRPAR_enavg, 'DRPAR', rc=status) + call MAPL_GetPointer(import, DRPAR_enavg, 'DRPAR', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, DFPAR_enavg, 'DFPAR', rc=status) + call MAPL_GetPointer(import, DFPAR_enavg, 'DFPAR', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, DRNIR_enavg, 'DRNIR', rc=status) + call MAPL_GetPointer(import, DRNIR_enavg, 'DRNIR', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, DFNIR_enavg, 'DFNIR', rc=status) + call MAPL_GetPointer(import, DFNIR_enavg, 'DFNIR', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, DRUVR_enavg, 'DRUVR', rc=status) + call MAPL_GetPointer(import, DRUVR_enavg, 'DRUVR', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, DFUVR_enavg, 'DFUVR', rc=status) + call MAPL_GetPointer(import, DFUVR_enavg, 'DFUVR', rc=status) _VERIFY(status) call MAPL_GetPointer(import, LWDNSRF_enavg, 'LWDNSRF', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, DZ_enavg, 'DZ', rc=status) + call MAPL_GetPointer(import, DZ_enavg, 'DZ', rc=status) _VERIFY(status) - call MAPL_GetPointer(import, SWLAND, 'SWLAND', rc=status) + call MAPL_GetPointer(import, SWLAND, 'SWLAND', rc=status) ! not _enavg _VERIFY(status) - call MAPL_GetPointer(import, LAI, 'LAI', rc=status) + call MAPL_GetPointer(import, LAI, 'LAI', rc=status) _VERIFY(status) ! ! export for incr ! - call MAPL_GetPointer(export, TC1_incr, 'TCFSAT_INCR' ,rc=status) + call MAPL_GetPointer(export, TC1_incr, 'TCFSAT_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, TC2_incr, 'TCFTRN_INCR' ,rc=status) + call MAPL_GetPointer(export, TC2_incr, 'TCFTRN_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, TC4_incr, 'TCFWLT_INCR' ,rc=status) + call MAPL_GetPointer(export, TC4_incr, 'TCFWLT_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, QC1_incr, 'QCFSAT_INCR' ,rc=status) + call MAPL_GetPointer(export, QC1_incr, 'QCFSAT_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, QC2_incr, 'QCFTRN_INCR' ,rc=status) + call MAPL_GetPointer(export, QC2_incr, 'QCFTRN_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, QC4_incr, 'QCFWLT_INCR' ,rc=status) + call MAPL_GetPointer(export, QC4_incr, 'QCFWLT_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, CAPAC_incr, 'CAPAC_INCR' ,rc=status) + call MAPL_GetPointer(export, CAPAC_incr, 'CAPAC_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, CATDEF_incr, 'CATDEF_INCR' ,rc=status) + call MAPL_GetPointer(export, CATDEF_incr, 'CATDEF_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, RZEXC_incr, 'RZEXC_INCR' ,rc=status) + call MAPL_GetPointer(export, RZEXC_incr, 'RZEXC_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, SRFEXC_incr, 'SRFEXC_INCR' ,rc=status) + call MAPL_GetPointer(export, SRFEXC_incr, 'SRFEXC_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT1_incr, 'GHTCNT1_INCR' ,rc=status) + call MAPL_GetPointer(export, GHTCNT1_incr, 'GHTCNT1_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT2_incr, 'GHTCNT2_INCR' ,rc=status) + call MAPL_GetPointer(export, GHTCNT2_incr, 'GHTCNT2_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT3_incr, 'GHTCNT3_INCR' ,rc=status) + call MAPL_GetPointer(export, GHTCNT3_incr, 'GHTCNT3_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT4_incr, 'GHTCNT4_INCR' ,rc=status) + call MAPL_GetPointer(export, GHTCNT4_incr, 'GHTCNT4_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT5_incr, 'GHTCNT5_INCR' ,rc=status) + call MAPL_GetPointer(export, GHTCNT5_incr, 'GHTCNT5_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT6_incr, 'GHTCNT6_INCR' ,rc=status) + call MAPL_GetPointer(export, GHTCNT6_incr, 'GHTCNT6_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, WESNN1_incr, 'WESNN1_INCR' ,rc=status) + call MAPL_GetPointer(export, WESNN1_incr, 'WESNN1_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, WESNN2_incr, 'WESNN2_INCR' ,rc=status) + call MAPL_GetPointer(export, WESNN2_incr, 'WESNN2_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, WESNN3_incr, 'WESNN3_INCR' ,rc=status) + call MAPL_GetPointer(export, WESNN3_incr, 'WESNN3_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, HTSNNN1_incr, 'HTSNNN1_INCR' ,rc=status) + call MAPL_GetPointer(export, HTSNNN1_incr, 'HTSNNN1_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, HTSNNN2_incr, 'HTSNNN2_INCR' ,rc=status) + call MAPL_GetPointer(export, HTSNNN2_incr, 'HTSNNN2_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, HTSNNN3_incr, 'HTSNNN3_INCR' ,rc=status) + call MAPL_GetPointer(export, HTSNNN3_incr, 'HTSNNN3_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, SNDZN1_incr, 'SNDZN1_INCR' ,rc=status) + call MAPL_GetPointer(export, SNDZN1_incr, 'SNDZN1_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, SNDZN2_incr, 'SNDZN2_INCR' ,rc=status) + call MAPL_GetPointer(export, SNDZN2_incr, 'SNDZN2_INCR' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, SNDZN3_incr, 'SNDZN3_INCR' ,rc=status) + call MAPL_GetPointer(export, SNDZN3_incr, 'SNDZN3_INCR' ,rc=status) _VERIFY(status) allocate(met_force(N_catl)) @@ -1525,290 +1512,283 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) met_force(:)%Snowf = SNO_enavg(:) met_force(:)%LWdown = LWDNSRF_enavg(:) met_force(:)%SWdown = DRPAR_enavg(:)+DFPAR_enavg(:)+DRNIR_enavg(:) + & - DFNIR_enavg(:)+DRUVR_enavg(:)+DFUVR_enavg(:) + DFNIR_enavg(:)+DRUVR_enavg(:)+DFUVR_enavg(:) met_force(:)%SWnet = SWLAND(:) met_force(:)%PARdrct = DRPAR_enavg(:) met_force(:)%PARdffs = DFPAR_enavg(:) met_force(:)%wind = UU_enavg(:) met_force(:)%RefH = DZ_enavg(:) - -! Weiyuan note: dummy adapt for now + + ! Weiyuan note: dummy adapt for now N_adapt_R = 0 !allocate(obs_pert_adapt_param(N_obs_param)) !allocate(Pert_adapt_R(N_adapt_R,NUM_ENSEMBLE)) !allocate(Obs_pert(N_obsl_max,NUM_ENSEMBLE)) - + if (N_obsbias_max>0) then - allocate(obs_bias(N_catl,N_obs_param,N_obsbias_max)) - call initialize_obs_bias( N_catf, N_obs_param, N_obsbias_max, trim(out_path), & - trim(exp_id), start_time, N_catl, numprocs, N_catl_vec, low_ind, obs_bias) + allocate(obs_bias(N_catl,N_obs_param,N_obsbias_max)) + call initialize_obs_bias( N_catf, N_obs_param, N_obsbias_max, trim(out_path), & + trim(exp_id), start_time, N_catl, numprocs, N_catl_vec, low_ind, obs_bias) end if - + allocate(cat_progn_incr(N_catl,NUM_ENSEMBLE)) allocate(cat_progn_incr_ensavg(N_catl)) allocate(Observations_l(N_obsl_max)) - - !WY note: temportary - - + + !WY note: temporary #ifdef DBG_LANDASSIM_INPUTS - + if (firsttime) then - firsttime = .false. - call MAPL_LocStreamGet(LOCSTREAM, TILEGRID=TILEGRID, RC=STATUS) - _VERIFY(STATUS) - - call MAPL_TileMaskGet(tilegrid, mask, rc=status) - _VERIFY(STATUS) - - allocate(metTair(N_catf),metTair_l(N_catl)) - allocate(ids(N_catf)) - - metTair_l(:) = met_force(:)%Tair - ids(:) = tile_coord_rf(:)%tile_id - - call MPI_AllGATHERV(metTair_l, N_catl, MPI_REAL, & - metTair, N_catl_vec, low_ind-1, MPI_REAL, & - mpicomm,mpierr) - - - if(myid ==0) then + firsttime = .false. + call MAPL_LocStreamGet(LOCSTREAM, TILEGRID=TILEGRID, RC=STATUS) + _VERIFY(STATUS) + + call MAPL_TileMaskGet(tilegrid, mask, rc=status) + _VERIFY(STATUS) + + allocate(metTair(N_catf),metTair_l(N_catl)) + allocate(ids(N_catf)) + + metTair_l(:) = met_force(:)%Tair + ids(:) = tile_coord_rf(:)%tile_id + + call MPI_AllGATHERV(metTair_l, N_catl, MPI_REAL, & + metTair, N_catl_vec, low_ind-1, MPI_REAL, & + mpicomm,mpierr) + + + if(myid ==0) then open(unit=10,file='metTair.txt',action="write",status="replace") do i = 1, N_catf - write(10,*) ids(i), metTair(i) + write(10,*) ids(i), metTair(i) enddo close(10) - endif - - unit = GETFILE( "landassim_force_inputs.bin", form="unformatted", RC=STATUS ) - _VERIFY(STATUS) -! Inputs - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Tair, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Qair, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Psurf, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf_c, mask=mask, rc=status); _VERIFY(STATUS) - - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%Snowf, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%LWdown, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWdown, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWnet, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdrct,mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdffs, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%wind, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, met_force(:)%RefH, mask=mask, rc=status); _VERIFY(STATUS) - - unit = GETFILE( "landassim_catprogn_inputs.bin", form="unformatted", RC=STATUS ) - _VERIFY(STATUS) + endif - ens_id = 1 - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc1, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc2, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc4, mask=mask, rc=status); _VERIFY(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa1, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa2, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa4, mask=mask, rc=status); _VERIFY(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%capac, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%catdef, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%rzexc, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%srfexc, mask=mask, rc=status); _VERIFY(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(1), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(2), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(3), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(4), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(5), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(6), mask=mask, rc=status); _VERIFY(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(1), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(2), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(3), mask=mask, rc=status); _VERIFY(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(1), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(2), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(3), mask=mask, rc=status); _VERIFY(STATUS) - - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(1), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(2), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(3), mask=mask, rc=status); _VERIFY(STATUS) - - - unit = GETFILE( "landassim_mwrtm_inputs.bin", form="unformatted", RC=STATUS ) - _VERIFY(STATUS) + unit = GETFILE( "landassim_force_inputs.bin", form="unformatted", RC=STATUS ) + _VERIFY(STATUS) + ! Inputs + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Tair, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Qair, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Psurf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf_c, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%vegcls), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%soilcls), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%sand, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%clay, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%poros, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wt, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wp, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmin, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmax, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmin, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmax, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrh, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrv, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_polmix,mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%omega, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bh, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bv, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%lewt, mask=mask, rc=status); _VERIFY(STATUS) - - !unit = GETFILE( "landassim_catparam_inputs.bin", form="unformatted", RC=STATUS ) - !_VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Rainf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%Snowf, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%LWdown, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWdown, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%SWnet, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdrct,mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%PARdffs, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%wind, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, met_force(:)%RefH, mask=mask, rc=status); _VERIFY(STATUS) - endif - - - -#endif - - call get_enkf_increments( & - date_time_new, & - NUM_ENSEMBLE, N_catl, N_catf, N_obsl_max, & - trim(out_path), trim(exp_id), exp_domain, & - met_force, lai, cat_param, mwRTM_param, & - tile_coord_l, tile_coord_rf, tcinternal%grid_f, & - tcinternal%grid_f, tcinternal%grid_l, tcinternal%grid_g, & - N_catl_vec, low_ind, l2rf, rf2l, & - N_force_pert, N_progn_pert, force_pert_param, progn_pert_param, & - update_type, & - dtstep_assim, centered_update, & - xcompact, ycompact, fcsterr_inflation_fac, & - N_obs_param, obs_param, N_obsbias_max, & - out_obslog, out_smapL4SMaup, & - cat_progn, & - Pert_rseed, obs_bias, & - cat_progn_incr, fresh_incr, & - N_obsf, N_obsl, Observations_l, & - ! below are dummy for now - N_adapt_R, obs_pert_adapt_param, Pert_adapt_R) - !Obs_pert ) - - ! forced to apply - spin = .false. - - if (.not. spin) then - if (fresh_incr) then + unit = GETFILE( "landassim_catprogn_inputs.bin", form="unformatted", RC=STATUS ) + _VERIFY(STATUS) + + ens_id = 1 + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc1, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc2, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc4, mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa1, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa2, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa4, mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%capac, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%catdef, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%rzexc, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%srfexc, mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(3), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(4), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(5), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(6), mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(3), mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(3), mask=mask, rc=status); _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(3), mask=mask, rc=status); _VERIFY(STATUS) + + + unit = GETFILE( "landassim_mwrtm_inputs.bin", form="unformatted", RC=STATUS ) + _VERIFY(STATUS) + + call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%vegcls), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,real(mwRTM_param(:)%soilcls), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%sand, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%clay, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%poros, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wt, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%wang_wp, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmin, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_hmax, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmin, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_wmax, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrh, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_Nrv, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%rgh_polmix,mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%omega, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bh, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%bv, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid,mwRTM_param(:)%lewt, mask=mask, rc=status); _VERIFY(STATUS) + + !unit = GETFILE( "landassim_catparam_inputs.bin", form="unformatted", RC=STATUS ) + !_VERIFY(STATUS) + + endif + +#endif ! DBG_LANDASSIM_INPUTS + + call get_enkf_increments( & + date_time_new, & + NUM_ENSEMBLE, N_catl, N_catf, N_obsl_max, & + trim(out_path), trim(exp_id), exp_domain, & + met_force, lai, cat_param, mwRTM_param, & + tile_coord_l, tile_coord_rf, tcinternal%grid_f, & + tcinternal%grid_f, tcinternal%grid_l, tcinternal%grid_g, & + N_catl_vec, low_ind, l2rf, rf2l, & + N_force_pert, N_progn_pert, force_pert_param, progn_pert_param, & + update_type, & + dtstep_assim, centered_update, & + xcompact, ycompact, fcsterr_inflation_fac, & + N_obs_param, obs_param, N_obsbias_max, & + out_obslog, out_smapL4SMaup, & + cat_progn, & + Pert_rseed, obs_bias, & + cat_progn_incr, fresh_incr, & + N_obsf, N_obsl, Observations_l, & + ! below are dummy for now + N_adapt_R, obs_pert_adapt_param, Pert_adapt_R) + + ! forced to apply + spin = .false. + + if (.not. spin) then + if (fresh_incr) then ! apply EnKF increments ! (without call to subroutine recompute_diagnostics()) - call apply_enkf_increments( N_catl, NUM_ENSEMBLE, update_type, cat_param, & - cat_progn_incr, cat_progn ) - - end if ! fresh_incr - - ! if requested, write incr and/or ObsFcstAna files whenever it was - ! time for assimilation, even if there were no observations - ! - reichle, 29 Aug 2014 - - secs_in_day = & - date_time_new%hour*3600 + date_time_new%min*60 + date_time_new%sec - - if (centered_update) secs_in_day = secs_in_day + dtstep_assim/2 + call apply_enkf_increments( N_catl, NUM_ENSEMBLE, update_type, cat_param, & + cat_progn_incr, cat_progn ) + + end if ! fresh_incr - ! WY note : Here N_catg is not the global land tile number - ! but a maximum global_id this simulation covers. - ! Need to find the number - N_catg = maxval(rf2g) - - if (mod(secs_in_day, dtstep_assim)==0) then - - call output_incr_etc( out_ObsFcstAna, & - date_time_new, trim(out_path), trim(exp_id), & - N_obsl, N_obs_param, NUM_ENSEMBLE, & - N_catl, tile_coord_l, & - N_catf, tile_coord_rf, tcinternal%grid_f, tcinternal%grid_g, & - N_catl_vec, low_ind, rf2l, N_catg, rf2g, & - obs_param, & - met_force, lai, & - cat_param, cat_progn, cat_progn_incr, mwRTM_param, & - Observations_l, rf2f=rf2f ) - - - do i = 1, N_catl - cat_progn_incr_ensavg(i) = 0.0 - do n_e=1, NUM_ENSEMBLE - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & - + cat_progn_incr(i,n_e) - end do - cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE) - enddo - - if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 - if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 - if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 - if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 - if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 - if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 - - if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac - if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef - if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc - if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc - - if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) - if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) - if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) - if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) - if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) - if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) - - if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) - if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) - if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) - - if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) - if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) - if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) - - if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) - if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) - if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) - - - - ! write analysis fields into SMAP L4_SM aup file - ! whenever it was time for assimilation (regardless - ! of whether obs were actually assimilated and fresh - ! increments were computed) - - if (out_smapL4SMaup) & - call write_smapL4SMaup( 'analysis', date_time_new, trim(out_path), & - trim(exp_id), NUM_ENSEMBLE, N_catl, N_catf, N_obsl, tile_coord_rf, & - tcinternal%grid_g, N_catl_vec, low_ind, & - N_obs_param, obs_param, Observations_l, cat_param, cat_progn ) - - end if - - - fresh_incr = .false. - - endif !spin - - - -!-------------------- -! Pointers to inputs -!-------------------- + ! if requested, write incr and/or ObsFcstAna files whenever it was + ! time for assimilation, even if there were no observations + ! - reichle, 29 Aug 2014 + + secs_in_day = & + date_time_new%hour*3600 + date_time_new%min*60 + date_time_new%sec + + if (centered_update) secs_in_day = secs_in_day + dtstep_assim/2 + + ! WY note : Here N_catg is not the global land tile number + ! but a maximum global_id this simulation covers. + ! Need to find the number + N_catg = maxval(rf2g) + + if (mod(secs_in_day, dtstep_assim)==0) then + + call output_incr_etc( out_ObsFcstAna, & + date_time_new, trim(out_path), trim(exp_id), & + N_obsl, N_obs_param, NUM_ENSEMBLE, & + N_catl, tile_coord_l, & + N_catf, tile_coord_rf, tcinternal%grid_f, tcinternal%grid_g, & + N_catl_vec, low_ind, rf2l, N_catg, rf2g, & + obs_param, & + met_force, lai, & + cat_param, cat_progn, cat_progn_incr, mwRTM_param, & + Observations_l, rf2f=rf2f ) + + + do i = 1, N_catl + cat_progn_incr_ensavg(i) = 0.0 + do n_e=1, NUM_ENSEMBLE + cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i) & + + cat_progn_incr(i,n_e) + end do + cat_progn_incr_ensavg(i) = cat_progn_incr_ensavg(i)/real(NUM_ENSEMBLE) + enddo + + if(associated(TC1_incr)) TC1_incr(:) = cat_progn_incr_ensavg(:)%tc1 + if(associated(TC2_incr)) TC2_incr(:) = cat_progn_incr_ensavg(:)%tc2 + if(associated(TC4_incr)) TC4_incr(:) = cat_progn_incr_ensavg(:)%tc4 + if(associated(QC1_incr)) QC1_incr(:) = cat_progn_incr_ensavg(:)%qa1 + if(associated(QC2_incr)) QC2_incr(:) = cat_progn_incr_ensavg(:)%qa2 + if(associated(QC4_incr)) QC4_incr(:) = cat_progn_incr_ensavg(:)%qa4 + + if(associated(CAPAC_incr)) CAPAC_incr(:) = cat_progn_incr_ensavg(:)%capac + if(associated(CATDEF_incr)) CATDEF_incr(:) = cat_progn_incr_ensavg(:)%catdef + if(associated(RZEXC_incr)) RZEXC_incr(:) = cat_progn_incr_ensavg(:)%rzexc + if(associated(SRFEXC_incr)) SRFEXC_incr(:) = cat_progn_incr_ensavg(:)%srfexc + + if(associated(GHTCNT1_incr)) GHTCNT1_incr(:) = cat_progn_incr_ensavg(:)%ght(1) + if(associated(GHTCNT2_incr)) GHTCNT2_incr(:) = cat_progn_incr_ensavg(:)%ght(2) + if(associated(GHTCNT3_incr)) GHTCNT3_incr(:) = cat_progn_incr_ensavg(:)%ght(3) + if(associated(GHTCNT4_incr)) GHTCNT4_incr(:) = cat_progn_incr_ensavg(:)%ght(4) + if(associated(GHTCNT5_incr)) GHTCNT5_incr(:) = cat_progn_incr_ensavg(:)%ght(5) + if(associated(GHTCNT6_incr)) GHTCNT6_incr(:) = cat_progn_incr_ensavg(:)%ght(6) + + if(associated(WESNN1_incr)) WESNN1_incr(:) = cat_progn_incr_ensavg(:)%wesn(1) + if(associated(WESNN2_incr)) WESNN2_incr(:) = cat_progn_incr_ensavg(:)%wesn(2) + if(associated(WESNN3_incr)) WESNN3_incr(:) = cat_progn_incr_ensavg(:)%wesn(3) + + if(associated(HTSNNN1_incr)) HTSNNN1_incr(:) = cat_progn_incr_ensavg(:)%htsn(1) + if(associated(HTSNNN2_incr)) HTSNNN2_incr(:) = cat_progn_incr_ensavg(:)%htsn(2) + if(associated(HTSNNN3_incr)) HTSNNN3_incr(:) = cat_progn_incr_ensavg(:)%htsn(3) + + if(associated(SNDZN1_incr)) SNDZN1_incr(:) = cat_progn_incr_ensavg(:)%sndz(1) + if(associated(SNDZN2_incr)) SNDZN2_incr(:) = cat_progn_incr_ensavg(:)%sndz(2) + if(associated(SNDZN3_incr)) SNDZN3_incr(:) = cat_progn_incr_ensavg(:)%sndz(3) + + + ! write analysis fields into SMAP L4_SM aup file + ! whenever it was time for assimilation (regardless + ! of whether obs were actually assimilated and fresh + ! increments were computed) + + if (out_smapL4SMaup) & + call write_smapL4SMaup( 'analysis', date_time_new, trim(out_path), & + trim(exp_id), NUM_ENSEMBLE, N_catl, N_catf, N_obsl, tile_coord_rf, & + tcinternal%grid_g, N_catl_vec, low_ind, & + N_obs_param, obs_param, Observations_l, cat_param, cat_progn ) + + end if + + fresh_incr = .false. + + endif !spin + + + + !-------------------- + ! Pointers to inputs + !-------------------- deallocate(cat_progn_incr) deallocate(cat_progn_incr_ensavg) deallocate(Observations_l) - + call MAPL_TimerOff ( MAPL, "RUN" ) call MAPL_TimerOff ( MAPL, "TOTAL" ) - + RETURN_(ESMF_SUCCESS) - -end subroutine RUN - - ! !IROTUINE: collecting and averaging - -subroutine UPDATE_ASSIM(gc, import, export, clock, rc) - + + end subroutine RUN + + ! !IROTUINE: collecting and averaging + + subroutine UPDATE_ASSIM(gc, import, export, clock, rc) + ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: gc ! Gridded component @@ -1817,7 +1797,7 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code - + ! ErrLog variables integer :: status character(len=ESMF_MAXSTR) :: Iam='UPDATE_ASSIM' @@ -1825,116 +1805,118 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) ! ESMF variables type(ESMF_Alarm) :: LandAssimAlarm - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm ! MAPL variables type(MAPL_MetaComp), pointer :: MAPL=>null() ! MAPL obj - + real, dimension(:,:),pointer :: TC real, dimension(:,:),pointer :: QC - real, dimension(:),pointer :: CAPAC - real, dimension(:),pointer :: CATDEF - real, dimension(:),pointer :: RZEXC - real, dimension(:),pointer :: SRFEXC - real, dimension(:),pointer :: GHTCNT1 - real, dimension(:),pointer :: GHTCNT2 - real, dimension(:),pointer :: GHTCNT3 - real, dimension(:),pointer :: GHTCNT4 - real, dimension(:),pointer :: GHTCNT5 - real, dimension(:),pointer :: GHTCNT6 - real, dimension(:),pointer :: WESNN1 - real, dimension(:),pointer :: WESNN2 - real, dimension(:),pointer :: WESNN3 - real, dimension(:),pointer :: HTSNNN1 - real, dimension(:),pointer :: HTSNNN2 - real, dimension(:),pointer :: HTSNNN3 - real, dimension(:),pointer :: SNDZN1 - real, dimension(:),pointer :: SNDZN2 - real, dimension(:),pointer :: SNDZN3 - - integer,save :: ens_id = 0 - - !BOP - + real, dimension(:), pointer :: CAPAC + real, dimension(:), pointer :: CATDEF + real, dimension(:), pointer :: RZEXC + real, dimension(:), pointer :: SRFEXC + real, dimension(:), pointer :: GHTCNT1 + real, dimension(:), pointer :: GHTCNT2 + real, dimension(:), pointer :: GHTCNT3 + real, dimension(:), pointer :: GHTCNT4 + real, dimension(:), pointer :: GHTCNT5 + real, dimension(:), pointer :: GHTCNT6 + real, dimension(:), pointer :: WESNN1 + real, dimension(:), pointer :: WESNN2 + real, dimension(:), pointer :: WESNN3 + real, dimension(:), pointer :: HTSNNN1 + real, dimension(:), pointer :: HTSNNN2 + real, dimension(:), pointer :: HTSNNN3 + real, dimension(:), pointer :: SNDZN1 + real, dimension(:), pointer :: SNDZN2 + real, dimension(:), pointer :: SNDZN3 + + integer, save :: ens_id = 0 + + !BOP + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) _VERIFY(STATUS) Iam=trim(COMP_NAME)//"::RUN" call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) _VERIFY(STATUS) - + call ESMF_ClockGetAlarm(clock, 'LandAssim', LandAssimAlarm, rc=status) _VERIFY(status) if ( .not. ESMF_AlarmIsRinging(LandAssimAlarm)) then RETURN_(ESMF_SUCCESS) endif - - call MAPL_GetPointer(export, TC, 'TC' ,rc=status) + + call MAPL_GetPointer(export, TC, 'TC' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, QC, 'QC' ,rc=status) + call MAPL_GetPointer(export, QC, 'QC' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, CAPAC, 'CAPAC' ,rc=status) + call MAPL_GetPointer(export, CAPAC, 'CAPAC' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, CATDEF, 'CATDEF' ,rc=status) + call MAPL_GetPointer(export, CATDEF, 'CATDEF' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, RZEXC, 'RZEXC' ,rc=status) + call MAPL_GetPointer(export, RZEXC, 'RZEXC' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, SRFEXC, 'SRFEXC' ,rc=status) + call MAPL_GetPointer(export, SRFEXC, 'SRFEXC' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT1, 'GHTCNT1' ,rc=status) + call MAPL_GetPointer(export, GHTCNT1, 'GHTCNT1' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT2, 'GHTCNT2' ,rc=status) + call MAPL_GetPointer(export, GHTCNT2, 'GHTCNT2' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT3, 'GHTCNT3' ,rc=status) + call MAPL_GetPointer(export, GHTCNT3, 'GHTCNT3' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT4, 'GHTCNT4' ,rc=status) + call MAPL_GetPointer(export, GHTCNT4, 'GHTCNT4' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT5, 'GHTCNT5' ,rc=status) + call MAPL_GetPointer(export, GHTCNT5, 'GHTCNT5' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, GHTCNT6, 'GHTCNT6' ,rc=status) + call MAPL_GetPointer(export, GHTCNT6, 'GHTCNT6' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, WESNN1, 'WESNN1' ,rc=status) + call MAPL_GetPointer(export, WESNN1, 'WESNN1' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, WESNN2, 'WESNN2' ,rc=status) + call MAPL_GetPointer(export, WESNN2, 'WESNN2' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, WESNN3, 'WESNN3' ,rc=status) + call MAPL_GetPointer(export, WESNN3, 'WESNN3' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, HTSNNN1, 'HTSNNN1' ,rc=status) + call MAPL_GetPointer(export, HTSNNN1, 'HTSNNN1' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, HTSNNN2, 'HTSNNN2' ,rc=status) + call MAPL_GetPointer(export, HTSNNN2, 'HTSNNN2' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, HTSNNN3, 'HTSNNN3' ,rc=status) + call MAPL_GetPointer(export, HTSNNN3, 'HTSNNN3' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, SNDZN1, 'SNDZN1' ,rc=status) + call MAPL_GetPointer(export, SNDZN1, 'SNDZN1' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, SNDZN2, 'SNDZN2' ,rc=status) + call MAPL_GetPointer(export, SNDZN2, 'SNDZN2' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(export, SNDZN3, 'SNDZN3' ,rc=status) + call MAPL_GetPointer(export, SNDZN3, 'SNDZN3' ,rc=status) _VERIFY(status) ! This counter is relative to ens_id ens_id = ens_id + 1 - !distrbute catch_progn - + + !distribute catch_progn TC(:,1) = cat_progn(:,ens_id)%tc1 TC(:,2) = cat_progn(:,ens_id)%tc2 TC(:,3) = cat_progn(:,ens_id)%tc4 - + QC(:,1) = cat_progn(:,ens_id)%qa1 QC(:,2) = cat_progn(:,ens_id)%qa2 QC(:,3) = cat_progn(:,ens_id)%qa4 - + CAPAC(:) = cat_progn(:,ens_id)%capac + CATDEF(:) = cat_progn(:,ens_id)%catdef RZEXC(:) = cat_progn(:,ens_id)%rzexc SRFEXC(:) = cat_progn(:,ens_id)%srfexc + GHTCNT1(:) = cat_progn(:,ens_id)%ght(1) GHTCNT2(:) = cat_progn(:,ens_id)%ght(2) GHTCNT3(:) = cat_progn(:,ens_id)%ght(3) GHTCNT4(:) = cat_progn(:,ens_id)%ght(4) GHTCNT5(:) = cat_progn(:,ens_id)%ght(5) GHTCNT6(:) = cat_progn(:,ens_id)%ght(6) - + WESNN1(:) = cat_progn(:,ens_id)%wesn(1) WESNN2(:) = cat_progn(:,ens_id)%wesn(2) WESNN3(:) = cat_progn(:,ens_id)%wesn(3) @@ -1942,40 +1924,42 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) HTSNNN1(:) = cat_progn(:,ens_id)%htsn(1) HTSNNN2(:) = cat_progn(:,ens_id)%htsn(2) HTSNNN3(:) = cat_progn(:,ens_id)%htsn(3) - + SNDZN1(:) = cat_progn(:,ens_id)%sndz(1) SNDZN2(:) = cat_progn(:,ens_id)%sndz(2) SNDZN3(:) = cat_progn(:,ens_id)%sndz(3) - + if(ens_id == NUM_ENSEMBLE ) ens_id = 0 - + ! End RETURN_(ESMF_SUCCESS) - -end subroutine UPDATE_ASSIM - - -! subroutine to calculate Tb - -subroutine CALC_LAND_TB(gc, import, export, clock, rc) + + end subroutine UPDATE_ASSIM + + + ! subroutine to calculate Tb for HISTORY output + + subroutine CALC_LAND_TB(gc, import, export, clock, rc) type(ESMF_GridComp), intent(inout) :: gc ! Gridded component type(ESMF_State), intent(inout) :: import ! Import state ! this import is from land grid component type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code - + + + ! hard-coded SMAP Tb parameters real, parameter :: freq = 1.41e9 ! microwave frequency [Hz] real, parameter :: inc_angle = 40. ! incidence angle [deg] logical, parameter :: incl_atm_terms = .false. ! no atmospheric correction, ie, get Tb at top-of-vegetation - integer :: status - character(len=ESMF_MAXSTR) :: Iam='CALC_LAND_TB' - character(len=ESMF_MAXSTR) :: comp_name - ! MAPL variables + integer :: status + character(len=ESMF_MAXSTR) :: Iam='CALC_LAND_TB' + character(len=ESMF_MAXSTR) :: comp_name + ! MAPL variables type(MAPL_MetaComp), pointer :: MAPL=>null() ! MAPL obj - type(ESMF_State) :: INTERNAL - + type(ESMF_State) :: INTERNAL + real, dimension(:), pointer :: LAI real, dimension(:), pointer :: TP1 real, dimension(:), pointer :: TPSURF @@ -2000,357 +1984,358 @@ subroutine CALC_LAND_TB(gc, import, export, clock, rc) real, dimension(:), pointer :: BH real, dimension(:), pointer :: BV real, dimension(:), pointer :: LEWT + ! export real, dimension(:), pointer :: TB_H_enavg real, dimension(:), pointer :: TB_V_enavg + ! local real, allocatable, dimension(:) :: sfmc_mwRTM, tsoil_mwRTM real, allocatable, dimension(:) :: dummy_real real, allocatable, dimension(:) :: Tb_v_tmp, TB_h_tmp - - - - integer :: N_catl, n, mpierr + + integer :: N_catl, n, mpierr type(MAPL_LocStream) :: locstream - logical :: is_nodata, all_nodata_l - + call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) _VERIFY(STATUS) Iam=trim(COMP_NAME)//"::RUN" - + call MAPL_GetPointer(export, TB_H_enavg, 'TB_LAND_1410MHZ_40DEG_HPOL' ,rc=status) _VERIFY(status) call MAPL_GetPointer(export, TB_V_enavg, 'TB_LAND_1410MHZ_40DEG_VPOL' ,rc=status) _VERIFY(STATUS) - - !if HISTORY does not ask for these varaibles, no calculation necessary + + !if HISTORY does not ask for these variables, no calculation necessary; return if (.not. associated(TB_H_enavg) .or. .not. associated(TB_V_enavg)) then - _RETURN(_SUCCESS) + _RETURN(_SUCCESS) endif - + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) _VERIFY(status) call MAPL_Get(MAPL, LocStream=locstream,rc=status) _VERIFY(status) call MAPL_LocStreamGet(locstream, NT_LOCAL=N_catl,rc=status) _VERIFY(status) - -! Pointers to internals -!---------------------- + + ! Pointers to internals + !---------------------- call MAPL_Get(MAPL, INTERNAL_ESMF_STATE=INTERNAL, rc=status) _VERIFY(status) - + call get_mwrtm_param(INTERNAL, N_catl, rc=status) _VERIFY(STATUS) - !WE DO NOT HAVE "mwRTM_param", but ask for TB from HISTORY, report error - if (all_nodata) then - _ASSERT(.false., "no mwRTM data, do not ask for TB ensemble average") + ! make sure that at least some mwRTM parameters are not nodata + if (mwRTM_all_nodata) then + _ASSERT(.false., "Tb output requested but all mwRTM parameters are nodata") endif - - call MAPL_GetPointer(import, LAI, 'LAI' ,rc=status) + + call MAPL_GetPointer(import, LAI, 'LAI' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(import, TP1, 'TP1' ,rc=status) + call MAPL_GetPointer(import, TP1, 'TP1' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(import, WCSF, 'WCSF' ,rc=status) + call MAPL_GetPointer(import, WCSF, 'WCSF' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(import, TPSURF, 'TPSURF' ,rc=status) + call MAPL_GetPointer(import, TPSURF, 'TPSURF' ,rc=status) _VERIFY(status) - call MAPL_GetPointer(import, SWE, 'SNOWMASS' ,rc=status) + call MAPL_GetPointer(import, SWE, 'SNOWMASS' ,rc=status) _VERIFY(status) - - ! convert Catchment model variables into inputs suitable for the mwRTM - ! NOTE: input tp must be in degree Celsius! - allocate(sfmc_mwRTM(N_catl), tsoil_mwRTM (N_catl)) - call catch2mwRTM_vars( & - N_catl, & - cat_param%vegcls, & ! intent(in), 'ITY' from imports (*cat_param* vegcls) --- not used anymore but keep for now - cat_param%poros, & ! intent(in), 'POROS' from imports (*cat_param* poros) - mwRTM_param%poros,& ! intent(in), 'MWRTM_POROS' = mw_poros - WCSF, & - TPSURF, & - TP1-MAPL_TICE, & ! units deg C !!! - sfmc_mwRTM, & ! intent(out), local variable - tsoil_mwRTM ) ! intent(out), local variable - - ! calculate brightness temperatures - ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] - ! but without Pellarin atmospheric corrections) - - ! IF NEEDED, USE DUMMY VARIABLES FOR tile_coord%elev AND Tair ALONG WITH AN IF STATEMENT AS FOLLOWS: + + ! convert Catchment model variables into inputs suitable for the mwRTM + ! NOTE: input TP1 must be in degree Celsius! + allocate(sfmc_mwRTM(N_catl), tsoil_mwRTM (N_catl)) + call catch2mwRTM_vars( & + N_catl, & + cat_param%vegcls, & ! not used anymore but keep for now + cat_param%poros, & + mwRTM_param%poros, & + WCSF, & + TPSURF, & + TP1-MAPL_TICE, & ! units deg C !!! + sfmc_mwRTM, & + tsoil_mwRTM ) + + ! calculate brightness temperatures + ! (tau-omega model as in De Lannoy et al. 2013 [doi:10.1175/JHM-D-12-092.1] + ! but without Pellarin atmospheric corrections) + + allocate(TB_h_tmp(N_catl), TB_v_tmp(N_catl)) + + if (.not. incl_atm_terms) then + allocate(dummy_real(N_catl)) ! allocate needed for GNU compiler + call mwRTM_get_Tb( & + N_catl, freq, inc_angle, mwRTM_param, & + dummy_real, & ! intent(in), "elev", not used as long as "incl_atm_terms=.false." + LAI, & + sfmc_mwRTM, & + tsoil_mwRTM, & + SWE, & + dummy_real, & ! intent(in), "Tair", not used as long as "incl_atm_terms=.false." + incl_atm_terms, & + Tb_h_tmp, Tb_v_tmp ) ! intent(out) 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' + deallocate(dummy_real) + else + _ASSERT(.false., "top-of-atmosphere Tb calculation not yet implemented (incl_atm_terms=.true.)") + end if + + if (collect_tb_counter == 0) then + TB_V_enavg = 0. + TB_H_enavg = 0. + endif + + ! This counter is relative to ens_id + collect_tb_counter = collect_tb_counter + 1 + + TB_V_enavg(:) = TB_V_enavg(:) + Tb_v_tmp(:) + TB_H_enavg(:) = TB_H_enavg(:) + Tb_h_tmp(:) + + if (collect_tb_counter == NUM_ENSEMBLE) then + collect_tb_counter = 0 + TB_V_enavg(:) = TB_V_enavg(:)/NUM_ENSEMBLE + TB_H_enavg(:) = TB_H_enavg(:)/NUM_ENSEMBLE + endif + + deallocate(Tb_h_tmp, Tb_v_tmp, sfmc_mwRTM, tsoil_mwRTM) + + RETURN_(_SUCCESS) + end subroutine CALC_LAND_TB - allocate(TB_h_tmp(N_catl), TB_v_tmp(N_catl)) - - if (.not. incl_atm_terms) then - allocate(dummy_real(N_catl)) ! DO WE EVEN NEED TO ALLOCATE? - call mwRTM_get_Tb( & - N_catl, freq, inc_angle, mwRTM_param, & - dummy_real, & ! intent(in), "elev", not used as long as "incl_atm_terms=.false." - LAI, & - sfmc_mwRTM, & - tsoil_mwRTM, & - SWE, & - dummy_real, & ! intent(in), "Tair", not used as long as "incl_atm_terms=.false." - incl_atm_terms, & - Tb_h_tmp, Tb_v_tmp ) ! intent(out) 'TB_LAND_1410MHZ_40DEG_HPOL', 'TB_LAND_1410MHZ_40DEG_VPOL' - deallocate(dummy_real) - else - _ASSERT(.false., "incl_atm_terms should be .false.") - end if - if (collect_tb_counter == 0) then - TB_V_enavg = 0. - TB_H_enavg = 0. - endif - - ! This counter is relative to ens_id - collect_tb_counter = collect_tb_counter + 1 - - TB_V_enavg(:) = TB_V_enavg(:) + Tb_v_tmp(:) - TB_H_enavg(:) = TB_H_enavg(:) + Tb_h_tmp(:) + subroutine read_pert_rseed(seed_fname,pert_rseed_r8) + use netcdf + character(len=*),intent(in) :: seed_fname + real(kind=ESMF_KIND_R8),intent(inout) :: pert_rseed_r8(:) + + integer :: ncid, s_varid, en_dim, n_ens, id_varid, i, pos + logical :: file_exist + + inquire (file = trim(seed_fname), exist=file_exist) + if ( .not. file_exist) then + pert_rseed_r8 = 0 + return + endif + + call check( nf90_open(seed_fname, NF90_NOWRITE, ncid) ) + ! Get the varid of the data variable, based on its name. + call check( nf90_inq_varid(ncid, "pert_rseed", s_varid) ) + call check( nf90_get_var(ncid, s_varid, pert_rseed_r8) ) + + ! Close the file, freeing all resources. + call check( nf90_close(ncid) ) + + contains + subroutine check(status) + integer, intent ( in) :: status + + if(status /= nf90_noerr) then + print *, trim(nf90_strerror(status)) + stop 1 + end if + end subroutine check + end subroutine read_pert_rseed - if (collect_tb_counter == NUM_ENSEMBLE) then - collect_tb_counter = 0 - TB_V_enavg(:) = TB_V_enavg(:)/NUM_ENSEMBLE - TB_H_enavg(:) = TB_H_enavg(:)/NUM_ENSEMBLE - endif + subroutine write_pert_rseed(chk_fname, pert_rseed_r8) + use netcdf + character(len=*),intent(in) :: chk_fname + real(kind=ESMF_KIND_R8),intent(in) :: pert_rseed_r8(:) + character(len=*), parameter :: SHORT_NAME = "SHORT_NAME" + character(len=*), parameter :: LONG_NAME = "LONG_NAME" + character(len=*), parameter :: UNITS = "UNITS" + character(len=*), parameter :: s_SHORT = "obspert_rseed" + character(len=*), parameter :: s_long = "Observation_Perturbations_rseed" + character(len=*), parameter :: units_ = "1" + + integer :: nseeds + integer :: ncid, s_varid + integer :: seed_dimid + + nseeds = size(pert_rseed_r8) + + ! Create the file. + call check( nf90_create(trim(chk_fname), nf90_clobber + NF90_NETCDF4, ncid) ) + ! Define the dimensions. + call check( nf90_def_dim(ncid, "NRANDSEED", nseeds, seed_dimid) ) + call check( nf90_def_var(ncid, 'pert_rseed', NF90_DOUBLE, [seed_dimid], s_varid) ) + + ! Assign attribute + call check( nf90_put_att(ncid, s_varid, UNITS, units_) ) + call check( nf90_put_att(ncid, s_varid, SHORT_NAME, s_short) ) + call check( nf90_put_att(ncid, s_varid, LONG_NAME, s_long) ) + + ! End define mode. + call check( nf90_enddef(ncid) ) + + ! write varaible + call check( nf90_put_var(ncid, s_varid, pert_rseed_r8) ) + ! Close the file. + call check( nf90_close(ncid) ) + + contains + subroutine check(status) + integer, intent ( in) :: status + + if(status /= nf90_noerr) then + print *, trim(nf90_strerror(status)) + stop 1 + end if + end subroutine check + end subroutine write_pert_rseed - deallocate(Tb_h_tmp, Tb_v_tmp, sfmc_mwRTM, tsoil_mwRTM) - RETURN_(_SUCCESS) -end subroutine CALC_LAND_TB - -subroutine read_pert_rseed(seed_fname,pert_rseed_r8) - use netcdf - character(len=*),intent(in) :: seed_fname - real(kind=ESMF_KIND_R8),intent(inout) :: pert_rseed_r8(:) - - integer :: ncid, s_varid, en_dim, n_ens, id_varid, i, pos - logical :: file_exist - - inquire (file = trim(seed_fname), exist=file_exist) - if ( .not. file_exist) then - pert_rseed_r8 = 0 - return - endif - - call check( nf90_open(seed_fname, NF90_NOWRITE, ncid) ) - ! Get the varid of the data variable, based on its name. - call check( nf90_inq_varid(ncid, "pert_rseed", s_varid) ) - call check( nf90_get_var(ncid, s_varid, pert_rseed_r8) ) - - ! Close the file, freeing all resources. - call check( nf90_close(ncid) ) - - contains - subroutine check(status) - integer, intent ( in) :: status - - if(status /= nf90_noerr) then - print *, trim(nf90_strerror(status)) - stop 1 - end if - end subroutine check -end subroutine read_pert_rseed - -subroutine write_pert_rseed(chk_fname, pert_rseed_r8) - use netcdf - character(len=*),intent(in) :: chk_fname - real(kind=ESMF_KIND_R8),intent(in) :: pert_rseed_r8(:) - character(len=*), parameter :: SHORT_NAME = "SHORT_NAME" - character(len=*), parameter :: LONG_NAME = "LONG_NAME" - character(len=*), parameter :: UNITS = "UNITS" - character(len=*), parameter :: s_SHORT = "obspert_rseed" - character(len=*), parameter :: s_long = "Observation_Perturbations_rseed" - character(len=*), parameter :: units_ = "1" - integer :: nseeds - integer :: ncid, s_varid - integer :: seed_dimid - - nseeds = size(pert_rseed_r8) - - ! Create the file. - call check( nf90_create(trim(chk_fname), nf90_clobber + NF90_NETCDF4, ncid) ) -! Define the dimensions. - call check( nf90_def_dim(ncid, "NRANDSEED", nseeds, seed_dimid) ) - call check( nf90_def_var(ncid, 'pert_rseed', NF90_DOUBLE, [seed_dimid], s_varid) ) - - ! Assign attribute - call check( nf90_put_att(ncid, s_varid, UNITS, units_) ) - call check( nf90_put_att(ncid, s_varid, SHORT_NAME, s_short) ) - call check( nf90_put_att(ncid, s_varid, LONG_NAME, s_long) ) - - ! End define mode. - call check( nf90_enddef(ncid) ) - - ! write varaible - call check( nf90_put_var(ncid, s_varid, pert_rseed_r8) ) - ! Close the file. - call check( nf90_close(ncid) ) - - contains - subroutine check(status) - integer, intent ( in) :: status - - if(status /= nf90_noerr) then - print *, trim(nf90_strerror(status)) - stop 1 - end if - end subroutine check -end subroutine write_pert_rseed - - -subroutine get_mwrtm_param(internal,N_catl, rc) - type(ESMF_State), intent(inout) :: INTERNAL - integer, intent(in) :: N_catl - integer, optional, intent(out) :: rc - - real, dimension(:), pointer :: VEGCLS - real, dimension(:), pointer :: SOILCLS - real, dimension(:), pointer :: SAND - real, dimension(:), pointer :: CLAY - real, dimension(:), pointer :: mw_POROS - real, dimension(:), pointer :: WANGWT - real, dimension(:), pointer :: WANGWP - real, dimension(:), pointer :: RGHHMIN - real, dimension(:), pointer :: RGHHMAX - real, dimension(:), pointer :: RGHWMAX - real, dimension(:), pointer :: RGHWMIN - real, dimension(:), pointer :: RGHNRH - real, dimension(:), pointer :: RGHNRV - real, dimension(:), pointer :: RGHPOLMIX - real, dimension(:), pointer :: OMEGA - real, dimension(:), pointer :: BH - real, dimension(:), pointer :: BV - real, dimension(:), pointer :: LEWT + subroutine get_mwrtm_param(internal,N_catl, rc) + type(ESMF_State), intent(inout) :: INTERNAL + integer, intent(in) :: N_catl + integer, optional, intent(out) :: rc + + real, dimension(:), pointer :: VEGCLS + real, dimension(:), pointer :: SOILCLS + real, dimension(:), pointer :: SAND + real, dimension(:), pointer :: CLAY + real, dimension(:), pointer :: mw_POROS + real, dimension(:), pointer :: WANGWT + real, dimension(:), pointer :: WANGWP + real, dimension(:), pointer :: RGHHMIN + real, dimension(:), pointer :: RGHHMAX + real, dimension(:), pointer :: RGHWMAX + real, dimension(:), pointer :: RGHWMIN + real, dimension(:), pointer :: RGHNRH + real, dimension(:), pointer :: RGHNRV + real, dimension(:), pointer :: RGHPOLMIX + real, dimension(:), pointer :: OMEGA + real, dimension(:), pointer :: BH + real, dimension(:), pointer :: BV + real, dimension(:), pointer :: LEWT + + integer :: N_catl_tmp, n, mpierr, status + logical :: is_nodata, all_nodata_l + + if(allocated(mwRTM_param)) then + _RETURN(_SUCCESS) + endif + + call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, WANGWP , 'MWRTM_WANGWP' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHHMIN , 'MWRTM_RGHHMIN' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHHMAX , 'MWRTM_RGHHMAX' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHWMIN , 'MWRTM_RGHWMIN' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHWMAX , 'MWRTM_RGHWMAX' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHNRH , 'MWRTM_RGHNRH' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHNRV , 'MWRTM_RGHNRV' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) + _VERIFY(STATUS) + + N_catl_tmp = size(sand,1) + _ASSERT(N_catl_tmp == N_catl, "sanity check: N_catl should be consistent") + + allocate(mwRTM_param(N_catl)) + mwRTM_param(:)%sand = SAND(:) + mwRTM_param(:)%vegcls = nint(VEGCLS(:)) + mwRTM_param(:)%soilcls = nint(SOILCLS(:)) + mwRTM_param(:)%clay = CLAY(:) + mwRTM_param(:)%poros = mw_POROS(:) + mwRTM_param(:)%wang_wt = WANGWT(:) + mwRTM_param(:)%wang_wp = WANGWP(:) + mwRTM_param(:)%rgh_hmin = RGHHMIN(:) + mwRTM_param(:)%rgh_hmax = RGHHMAX(:) + mwRTM_param(:)%rgh_wmin = RGHWMIN(:) + mwRTM_param(:)%rgh_wmax = RGHWMAX(:) + mwRTM_param(:)%rgh_Nrh = RGHNRH(:) + mwRTM_param(:)%rgh_Nrv = RGHNRV(:) + mwRTM_param(:)%rgh_polmix= RGHPOLMIX(:) + mwRTM_param(:)%omega = OMEGA(:) + mwRTM_param(:)%bh = BH(:) + mwRTM_param(:)%bv = bv(:) + mwRTM_param(:)%lewt = LEWT(:) + + all_nodata_l = .true. + do n=1,N_catl + call mwRTM_param_nodata_check(mwRTM_param(n), is_nodata ) + if (.not. is_nodata) all_nodata_l = .false. + end do + + ! perform logical AND across elements + call MPI_AllReduce(all_nodata_l, mwRTM_all_nodata, 1, MPI_LOGICAL, & + MPI_LAND, mpicomm, mpierr) + _RETURN(_SUCCESS) + end subroutine get_mwrtm_param - integer :: N_catl_tmp, n, mpierr, status - logical :: is_nodata, all_nodata_l - - if(allocated(mwRTM_param)) then - _RETURN(_SUCCESS) - endif - - call MAPL_GetPointer(INTERNAL, SAND , 'MWRTM_SAND' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL,SOILCLS , 'MWRTM_SOILCLS' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, VEGCLS , 'MWRTM_VEGCLS' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, CLAY , 'MWRTM_CLAY' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, mw_POROS , 'MWRTM_POROS' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, WANGWT , 'MWRTM_WANGWT' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, WANGWP , 'MWRTM_WANGWP' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, RGHHMIN , 'MWRTM_RGHHMIN' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, RGHHMAX , 'MWRTM_RGHHMAX' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, RGHWMIN , 'MWRTM_RGHWMIN' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, RGHWMAX , 'MWRTM_RGHWMAX' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, RGHNRH , 'MWRTM_RGHNRH' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, RGHNRV , 'MWRTM_RGHNRV' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, RGHPOLMIX, 'MWRTM_RGHPOLMIX', RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, OMEGA , 'MWRTM_OMEGA' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, BH , 'MWRTM_BH' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, BV , 'MWRTM_BV' , RC=STATUS) - _VERIFY(STATUS) - call MAPL_GetPointer(INTERNAL, LEWT , 'MWRTM_LEWT' , RC=STATUS) - _VERIFY(STATUS) - - N_catl_tmp = size(sand,1) - _ASSERT(N_catl_tmp == N_catl, "sanity check: N_catl should be consisten") - - allocate(mwRTM_param(N_catl)) - mwRTM_param(:)%sand = SAND(:) - mwRTM_param(:)%vegcls = nint(VEGCLS(:)) - mwRTM_param(:)%soilcls = nint(SOILCLS(:)) - mwRTM_param(:)%clay = CLAY(:) - mwRTM_param(:)%poros = mw_POROS(:) - mwRTM_param(:)%wang_wt = WANGWT(:) - mwRTM_param(:)%wang_wp = WANGWP(:) - mwRTM_param(:)%rgh_hmin = RGHHMIN(:) - mwRTM_param(:)%rgh_hmax = RGHHMAX(:) - mwRTM_param(:)%rgh_wmin = RGHWMIN(:) - mwRTM_param(:)%rgh_wmax = RGHWMAX(:) - mwRTM_param(:)%rgh_Nrh = RGHNRH(:) - mwRTM_param(:)%rgh_Nrv = RGHNRV(:) - mwRTM_param(:)%rgh_polmix= RGHPOLMIX(:) - mwRTM_param(:)%omega = OMEGA(:) - mwRTM_param(:)%bh = BH(:) - mwRTM_param(:)%bv = bv(:) - mwRTM_param(:)%lewt = LEWT(:) - - all_nodata_l = .true. - do n=1,N_catl - call mwRTM_param_nodata_check(mwRTM_param(n), is_nodata ) - if (.not. is_nodata) all_nodata_l = .false. - end do - - call MPI_AllReduce(all_nodata_l, all_nodata, 1, MPI_LOGICAL, & - MPI_LOR, mpicomm, mpierr) - _RETURN(_SUCCESS) -end subroutine - -!BOP -! !IROTUINE: Finalize -- finalize method for LDAS GC -! !INTERFACE: -subroutine Finalize(gc, import, export, clock, rc) - + !BOP + ! !IROTUINE: Finalize -- finalize method for LDAS GC + ! !INTERFACE: + subroutine Finalize(gc, import, export, clock, rc) + ! !ARGUMENTS: - + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component type(ESMF_State), intent(inout) :: import ! Import state type(ESMF_State), intent(inout) :: export ! Export state type(ESMF_Clock), intent(inout) :: clock ! The clock integer, optional, intent( out) :: rc ! Error code - + !EOP - + ! ErrLog variables - integer :: status - character(len=ESMF_MAXSTR) :: Iam - character(len=ESMF_MAXSTR) :: comp_name + integer :: status + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: comp_name type(MAPL_MetaComp), pointer :: MAPL=>null() - character(len=300) :: seed_fname - character(len=300) :: fname_tpl - character(len=300) :: out_path - character(len=ESMF_MAXSTR) :: exp_id - character(len=4) :: id_string - character(len=14):: datestamp - integer :: ens, nymd, nhms + character(len=300) :: seed_fname + character(len=300) :: fname_tpl + character(len=300) :: out_path + character(len=ESMF_MAXSTR) :: exp_id + character(len=4) :: id_string + character(len=14) :: datestamp + integer :: ens, nymd, nhms + ! Get component's name and setup traceback handle call ESMF_GridCompget(gc, name=comp_name, rc=status) _VERIFY(status) Iam = trim(comp_name) // "::Finalize" - + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS ) _VERIFY(STATUS) - + if( land_assim) then call MAPL_GetResource ( MAPL, out_path, Label="OUT_PATH:", DEFAULT="./", RC=STATUS) _VERIFY(STATUS) call MAPL_GetResource ( MAPL, exp_id, Label="EXP_ID:", DEFAULT="exp_id", RC=STATUS) _VERIFY(STATUS) - + if (master_proc) then call finalize_obslog() Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", & - DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) + DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) _VERIFY(STATUS) call MAPL_DateStampGet( clock, datestamp, rc=status) _VERIFY(STATUS) - + read(datestamp(1:8),*) nymd read(datestamp(10:13),*) nhms nhms = nhms*100 @@ -2363,12 +2348,13 @@ subroutine Finalize(gc, import, export, clock, rc) enddo endif endif ! land_assim - + ! Call Finalize for every child call MAPL_GenericFinalize(gc, import, export, clock, rc=status) _VERIFY(status) - + RETURN_(ESMF_SUCCESS) + + end subroutine Finalize -end subroutine Finalize end module GEOS_LandAssimGridCompMod From 7178f232debe289c8a4e37028e10255e80120acc Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sat, 16 May 2020 10:01:46 -0400 Subject: [PATCH 10/19] further polish --- src/Applications/LDAS_App/GEOSldas_HIST.rc | 48 +++++++++---------- src/Applications/LDAS_App/ldas_setup | 8 ++-- src/Applications/LDAS_App/process_hist.csh | 2 +- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 21 +++----- .../GEOS_LandAssimGridComp.F90 | 16 ++++--- .../GEOS_MetforceGridComp.F90 | 34 ++++++------- 6 files changed, 63 insertions(+), 66 deletions(-) diff --git a/src/Applications/LDAS_App/GEOSldas_HIST.rc b/src/Applications/LDAS_App/GEOSldas_HIST.rc index 42c71954..193b7554 100644 --- a/src/Applications/LDAS_App/GEOSldas_HIST.rc +++ b/src/Applications/LDAS_App/GEOSldas_HIST.rc @@ -36,18 +36,18 @@ COLLECTIONS: tavg24_1d_lfs_Nt.mode: 'time-averaged', tavg24_1d_lfs_Nt.frequency: 240000, tavg24_1d_lfs_Nt.ref_time: 000000, - tavg24_1d_lfs_Nt.fields:'Tair' , 'DATAATM' , - 'Qair' , 'DATAATM' , - 'LWdown' , 'DATAATM' , - 'SWdown' , 'DATAATM' , - 'Wind' , 'DATAATM' , - 'Psurf' , 'DATAATM' , - 'Rainf_C' , 'DATAATM' , - 'Rainf' , 'DATAATM' , - 'Snowf' , 'DATAATM' , - 'RainfSnowf' , 'DATAATM' , - 'SWnet' , 'DATAATM' , - 'RefH' , 'DATAATM' , + tavg24_1d_lfs_Nt.fields:'Tair' , 'METFORCE' , + 'Qair' , 'METFORCE' , + 'LWdown' , 'METFORCE' , + 'SWdown' , 'METFORCE' , + 'Wind' , 'METFORCE' , + 'Psurf' , 'METFORCE' , + 'Rainf_C' , 'METFORCE' , + 'Rainf' , 'METFORCE' , + 'Snowf' , 'METFORCE' , + 'RainfSnowf' , 'METFORCE' , + 'SWnet' , 'METFORCE' , + 'RefH' , 'METFORCE' , 'CATDEF' , 'GridComp' , 'RZEXC' , 'GridComp' , 'SRFEXC' , 'GridComp' , @@ -68,18 +68,18 @@ COLLECTIONS: tavg24_2d_lfs_Nx.regrid_name: 'GRIDNAME', tavg24_2d_lfs_Nx.grid_label: PC720x361-DC, tavg24_2d_lfs_Nx.deflate: 2, - tavg24_2d_lfs_Nx.fields:'Tair' , 'DATAATM' , - 'Qair' , 'DATAATM' , - 'LWdown' , 'DATAATM' , - 'SWdown' , 'DATAATM' , - 'Wind' , 'DATAATM' , - 'Psurf' , 'DATAATM' , - 'Rainf_C' , 'DATAATM' , - 'Rainf' , 'DATAATM' , - 'Snowf' , 'DATAATM' , - 'RainfSnowf' , 'DATAATM' , - 'SWnet' , 'DATAATM' , - 'RefH' , 'DATAATM' , + tavg24_2d_lfs_Nx.fields:'Tair' , 'METFORCE' , + 'Qair' , 'METFORCE' , + 'LWdown' , 'METFORCE' , + 'SWdown' , 'METFORCE' , + 'Wind' , 'METFORCE' , + 'Psurf' , 'METFORCE' , + 'Rainf_C' , 'METFORCE' , + 'Rainf' , 'METFORCE' , + 'Snowf' , 'METFORCE' , + 'RainfSnowf' , 'METFORCE' , + 'SWnet' , 'METFORCE' , + 'RefH' , 'METFORCE' , 'CATDEF' , 'GridComp' , 'RZEXC' , 'GridComp' , 'SRFEXC' , 'GridComp' , diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 94e94cb7..6632212b 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -835,11 +835,11 @@ class LDASsetup: # mwRTM restart file mwRTMRstFile = "" - _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 + #_assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 if 'MWRTM_FILE' in self.rqdExeInp : mwRTMRstFile = self.rqdExeInp['MWRTM_FILE'] - elif _assim ==1 : - mwRTMRstFile= rcoutpath +'/' + y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.ldas_mwRTMparam.'+y4m2d2_h2m2+'z.nc4' + #elif _assim ==1 : + # mwRTMRstFile= rcoutpath +'/' + y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.ldas_mwRTMparam.'+y4m2d2_h2m2+'z.nc4' if os.path.isfile(mwRTMRstFile) : self.has_mwrtm = True @@ -1050,7 +1050,7 @@ class LDASsetup: rstval=[self.catch,'vegdyn','landpert'] _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 - if self.has_mwrtm and _assim ==1 : + if self.has_mwrtm : # and _assim ==1 : keyn='LANDASSIM_INTERNAL_RESTART_FILE' valn='../input/restart/mwrtm_param_rst' ldasrcInp[keyn]= valn diff --git a/src/Applications/LDAS_App/process_hist.csh b/src/Applications/LDAS_App/process_hist.csh index dc730a6a..4adfb2c3 100755 --- a/src/Applications/LDAS_App/process_hist.csh +++ b/src/Applications/LDAS_App/process_hist.csh @@ -46,7 +46,7 @@ endif if($PERTURB == 1 ) then set GridComp = ENSAVG sed -i 's|VEGDYN|'VEGDYN0000'|g' $HISTRC - sed -i 's|DATAATM|'DATAATM0000'|g' $HISTRC +# sed -i 's|DATAATM|'DATAATM0000'|g' $HISTRC endif sed -i 's|GridComp|'$GridComp'|g' $HISTRC diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index 99720554..266915b3 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -8,10 +8,6 @@ module GEOS_LdasGridCompMod use ESMF use MAPL_Mod - !use MAPL_GridManagerMod, only: grid_manager - !use MAPL_RegridderManagerMod - !use MAPL_AbstractRegridderMod - !use MAPL_RegridderSpecMod use GEOS_MetforceGridCompMod, only: MetforceSetServices => SetServices use GEOS_LandGridCompMod, only: LandSetServices => SetServices @@ -97,7 +93,7 @@ subroutine SetServices(gc, rc) type(TILECOORD_WRAP) :: tcwrap type(ESMF_Config) :: CF - + integer :: LSM_CHOICE ! Begin... @@ -169,17 +165,15 @@ subroutine SetServices(gc, rc) call MAPL_GetResource ( MAPL, mwRTM_file, Label="MWRTM_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) mwRTM = ( len_trim(mwRTM_file) /= 0 ) - ! - ! ^^^^^^^^^^^^^^^^^^^^ CLEAN UP THE ABOVE COMMENTS WHEN WE ARE DONE WITH THE EDITS HERE. - - ! ADD STOP HERE IF (LSM_CHOICE/=1) .and. (mwRTM .or. land_assim) ?? - ! ==> avoid users trying to run LandAssim GC with CatchCN + call MAPL_GetResource ( MAPL, LSM_CHOICE, Label="LSM_CHOICE:", DEFAULT=1, RC=STATUS) + if (LSM_CHOICE /=1 ) then + _ASSERT( .not. (mwRTM .or. land_assim), "CATCHCN is Not Ready for assimilation or mwRTM") + endif allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) - ! one METFORCE provides all the (unperturbed) forcing data - ens_id(1)=0 ! id start form 0 <== ?? IS THIS INCONSISTENT WITH "FIRST_ENS_ID" USED IN GEOS_LandAssimGridComp.F90? + ens_id(1)=0 if(NUM_ENSEMBLE ==1 ) then id_string='' else @@ -188,8 +182,7 @@ subroutine SetServices(gc, rc) write(id_string, fmt_str) ens_id(1) endif id_string=trim(id_string) - childname='METFORCE'//trim(id_string) ! <== ?? DO WE NEED TO APPEND id_string? CAN THIS (AND THE PRECEDING LINES) BE REMOVED? - METFORCE = MAPL_AddChild(gc, name=childname, ss=MetforceSetServices, rc=status) + METFORCE = MAPL_AddChild(gc, name='METFORCE', ss=MetforceSetServices, rc=status) VERIFY_(status) do i=1,NUM_ENSEMBLE diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 15c886b2..879bc0ed 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -135,6 +135,7 @@ subroutine SetServices ( GC, RC ) ! Local Variables type(MAPL_MetaComp), pointer :: MAPL=>null() type(ESMF_Config) :: CF + character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file ! Begin... ! -------- @@ -149,11 +150,16 @@ subroutine SetServices ( GC, RC ) call MAPL_GetObjectFromGC(gc, MAPL, rc=status) _VERIFY(status) - - call MAPL_GetResource ( MAPL, land_assim, Label="LAND_ASSIM:", DEFAULT = .false., RC=STATUS) + + 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) - call MAPL_GetResource ( MAPL, mwRTM, Label="mwRTM:", DEFAULT = .false., RC=STATUS) + land_assim = (trim(LAND_ASSIM_STR) /= 'NO') + + call MAPL_GetResource ( MAPL, mwRTM_file, Label="MWRTM_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) + mwRTM = ( len_trim(mwRTM_file) /= 0 ) ! Register services for this component call MAPL_GridCompSetEntryPoint( & @@ -991,10 +997,8 @@ subroutine Initialize(gc, import, export, clock, rc) call init_log( myid, numprocs, master_proc ) if ( .not. land_assim) then ! to arrive here, mwRTM must be .true. - ! only need to calculate Tb for HISTORY; no processing of assimilation obs necessary; ! generic initialization is sufficient - call MAPL_GenericInitialize(gc, import, export, clock, rc=status) _VERIFY(status) @@ -2328,7 +2332,7 @@ subroutine Finalize(gc, import, export, clock, rc) _VERIFY(STATUS) if (master_proc) then - call finalize_obslog() + if (out_obslog) call finalize_obslog() Pert_rseed_r8 = Pert_rseed call MAPL_GetResource ( MAPL, fname_tpl, Label="LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE:", & DEFAULT="landassim_obspertrseed%s_checkpoint", RC=STATUS) diff --git a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index b1ed0f41..f91a66cf 100644 --- a/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -62,13 +62,13 @@ module GEOS_MetforceGridCompMod end type T_MET_FORCING ! Internal state and its wrapper - type T_DATAATM_STATE + type T_METFORCE_STATE private type(T_MET_FORCING) :: mf - end type T_DATAATM_STATE - type DATAATM_WRAP - type(T_DATAATM_STATE), pointer :: ptr=>null() - end type DATAATM_WRAP + end type T_METFORCE_STATE + type METFORCE_WRAP + type(T_METFORCE_STATE), pointer :: ptr=>null() + end type METFORCE_WRAP !! Wrapper to the tile_coord variable !type T_TILECOORD_STATE @@ -104,8 +104,8 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: comp_name ! Local variables - type(T_DATAATM_STATE), pointer :: internal - type(DATAATM_WRAP) :: wrap + type(T_METFORCE_STATE), pointer :: internal + type(METFORCE_WRAP) :: wrap ! Begin... @@ -143,7 +143,7 @@ subroutine SetServices(gc, rc) allocate(internal, stat=status) VERIFY_(status) wrap%ptr => internal - call ESMF_UserCompSetInternalState(gc, 'Dataatm_state', wrap, status) + call ESMF_UserCompSetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) ! Set the state variable specs @@ -572,8 +572,8 @@ subroutine Initialize(gc, import, export, clock, rc) type(T_MET_FORCING) :: mf ! Internal private state variables - type(T_DATAATM_STATE), pointer :: internal=>null() - type(DATAATM_WRAP) :: wrap + type(T_METFORCE_STATE), pointer :: internal=>null() + type(METFORCE_WRAP) :: wrap type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), pointer :: tile_coord(:)=>null() @@ -606,7 +606,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) ! Get component's internal private state - call ESMF_UserCompGetInternalState(gc, 'Dataatm_state', wrap, status) + call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr @@ -767,8 +767,8 @@ subroutine Run(gc, import, export, clock, rc) type(date_time_type) :: force_time_prv, force_time_nxt, model_time_nxt ! Private internal state variables - type(T_DATAATM_STATE), pointer :: internal=>null() - type(DATAATM_WRAP) :: wrap + 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(:) @@ -851,7 +851,7 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) ! Get component's internal private state - call ESMF_UserCompGetInternalState(gc, 'Dataatm_state', wrap, status) + call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr @@ -1239,8 +1239,8 @@ subroutine Finalize(gc, import, export, clock, rc) ! Local variables type(MAPL_MetaComp), pointer :: MAPL=>null() ! MAPL obj - type(T_DATAATM_STATE), pointer :: internal - type(DATAATM_WRAP) :: wrap + type(T_METFORCE_STATE), pointer :: internal + type(METFORCE_WRAP) :: wrap type(ESMF_Alarm) :: MetForcing !external :: GEOS_closefile ! Begin... @@ -1255,7 +1255,7 @@ subroutine Finalize(gc, import, export, clock, rc) VERIFY_(status) ! Get component's internal private state - call ESMF_UserCompGetInternalState(gc, 'Dataatm_state', wrap, status) + call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr From 84eba7afbc9f31e16efaf2fbcab2f04865f329f6 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sat, 16 May 2020 13:20:31 -0400 Subject: [PATCH 11/19] fix FIRST_ENS_ID --- src/Applications/LDAS_App/ldas_setup | 5 +- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 24 ++-- .../GEOS_LandAssimGridComp.F90 | 110 +++++++++--------- 3 files changed, 66 insertions(+), 73 deletions(-) diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 6632212b..5a79ad30 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -138,8 +138,9 @@ class LDASsetup: _mydir = self.exphome + '/' + self.rqdExeInp['EXP_ID'] assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None - self.ensdirs = ['ens%04d'%iens for iens in xrange(self.nens)] - self.ensids = ['%04d'%iens for iens in xrange(self.nens)] + _first_ens_id = self.rqdExeInp.get('FIRST_ENS_ID',0) + self.ensdirs = ['ens%04d'%iens for iens in xrange( _first_ens_id, self.nens + _first_ens_id)] + self.ensids = ['%04d'%iens for iens in xrange(_first_ens_id, self.nens + _first_ens_id)] if (self.nens == 1) : self.ensdirs_avg = self.ensdirs self.ensids=[''] diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index 266915b3..0089c48e 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -94,7 +94,7 @@ subroutine SetServices(gc, rc) type(ESMF_Config) :: CF integer :: LSM_CHOICE - + integer :: FIRST_ENS_ID ! Begin... @@ -143,6 +143,8 @@ subroutine SetServices(gc, rc) VERIFY_(STATUS) call MAPL_GetResource ( MAPL, ens_id_width, Label="ENS_ID_WIDTH:", DEFAULT=0, RC=STATUS) VERIFY_(STATUS) + call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) ! ^^^^^^^^^^^^^^^^^^^^^ CLEAN UP THE FOLLOWING COMMENTS WHEN WE ARE DONE WITH THE EDITS HERE. ! @@ -170,25 +172,15 @@ subroutine SetServices(gc, rc) if (LSM_CHOICE /=1 ) then _ASSERT( .not. (mwRTM .or. land_assim), "CATCHCN is Not Ready for assimilation or mwRTM") endif - - allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) - ens_id(1)=0 - if(NUM_ENSEMBLE ==1 ) then - id_string='' - else - fmt_str='' - write (fmt_str, "(A2,I1,A1,I1,A1)") "(I", ens_id_width,".",ens_id_width,")" - write(id_string, fmt_str) ens_id(1) - endif - id_string=trim(id_string) METFORCE = MAPL_AddChild(gc, name='METFORCE', ss=MetforceSetServices, rc=status) VERIFY_(status) + allocate(ens_id(NUM_ENSEMBLE),LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) + write (fmt_str, "(A2,I1,A1,I1,A1)") "(I", ens_id_width,".",ens_id_width,")" do i=1,NUM_ENSEMBLE - - ens_id(i)=i-1 ! id start form 0 - if(NUM_ENSEMBLE ==1 ) then + ens_id(i) = i-1 + FIRST_ENS_ID ! id start form FIRST_ENS_ID + if(NUM_ENSEMBLE == 1 ) then id_string='' else write(id_string, fmt_str) ens_id(i) @@ -203,8 +195,8 @@ subroutine SetServices(gc, rc) childname='LAND'//trim(id_string) LAND(i) = MAPL_AddChild(gc, name=childname, ss=LandSetServices, rc=status) VERIFY_(status) - enddo + ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) VERIFY_(status) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 879bc0ed..f4e5be72 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -1312,7 +1312,7 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! vars for debugging purposes type(ESMF_Grid) :: TILEGRID integer, pointer :: mask(:) - integer :: nt,ens_id + integer :: nt, ens_counter integer, save :: unit_i=0 integer :: unit integer :: NT_GLOBAL,mpierr,i @@ -1590,39 +1590,39 @@ subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) unit = GETFILE( "landassim_catprogn_inputs.bin", form="unformatted", RC=STATUS ) _VERIFY(STATUS) - ens_id = 1 + ens_counter = 1 - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc1, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc2, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%tc4, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%tc1, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%tc2, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%tc4, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa1, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa2, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%qa4, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%qa1, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%qa2, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%qa4, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%capac, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%catdef, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%rzexc, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%srfexc, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%capac, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%catdef, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%rzexc, mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%srfexc, mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(1), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(2), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(3), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(4), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(5), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%ght(6), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(3), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(4), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(5), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%ght(6), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(1), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(2), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%wesn(3), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%wesn(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%wesn(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%wesn(3), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(1), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(2), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%htsn(3), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%htsn(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%htsn(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%htsn(3), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(1), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(2), mask=mask, rc=status); _VERIFY(STATUS) - call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_id)%sndz(3), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%sndz(1), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%sndz(2), mask=mask, rc=status); _VERIFY(STATUS) + call MAPL_VarWrite(unit, tilegrid, cat_progn(:,ens_counter)%sndz(3), mask=mask, rc=status); _VERIFY(STATUS) unit = GETFILE( "landassim_mwrtm_inputs.bin", form="unformatted", RC=STATUS ) @@ -1836,7 +1836,7 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) real, dimension(:), pointer :: SNDZN2 real, dimension(:), pointer :: SNDZN3 - integer, save :: ens_id = 0 + integer, save :: end_counter = 0 !BOP @@ -1897,43 +1897,43 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) _VERIFY(status) ! This counter is relative to ens_id - ens_id = ens_id + 1 + end_counter = ens_counter + 1 !distribute catch_progn - TC(:,1) = cat_progn(:,ens_id)%tc1 - TC(:,2) = cat_progn(:,ens_id)%tc2 - TC(:,3) = cat_progn(:,ens_id)%tc4 + TC(:,1) = cat_progn(:,end_counter)%tc1 + TC(:,2) = cat_progn(:,end_counter)%tc2 + TC(:,3) = cat_progn(:,end_counter)%tc4 - QC(:,1) = cat_progn(:,ens_id)%qa1 - QC(:,2) = cat_progn(:,ens_id)%qa2 - QC(:,3) = cat_progn(:,ens_id)%qa4 + QC(:,1) = cat_progn(:,end_counter)%qa1 + QC(:,2) = cat_progn(:,end_counter)%qa2 + QC(:,3) = cat_progn(:,end_counter)%qa4 - CAPAC(:) = cat_progn(:,ens_id)%capac + CAPAC(:) = cat_progn(:,end_counter)%capac - CATDEF(:) = cat_progn(:,ens_id)%catdef - RZEXC(:) = cat_progn(:,ens_id)%rzexc - SRFEXC(:) = cat_progn(:,ens_id)%srfexc + CATDEF(:) = cat_progn(:,end_counter)%catdef + RZEXC(:) = cat_progn(:,end_counter)%rzexc + SRFEXC(:) = cat_progn(:,end_counter)%srfexc - GHTCNT1(:) = cat_progn(:,ens_id)%ght(1) - GHTCNT2(:) = cat_progn(:,ens_id)%ght(2) - GHTCNT3(:) = cat_progn(:,ens_id)%ght(3) - GHTCNT4(:) = cat_progn(:,ens_id)%ght(4) - GHTCNT5(:) = cat_progn(:,ens_id)%ght(5) - GHTCNT6(:) = cat_progn(:,ens_id)%ght(6) + GHTCNT1(:) = cat_progn(:,end_counter)%ght(1) + GHTCNT2(:) = cat_progn(:,end_counter)%ght(2) + GHTCNT3(:) = cat_progn(:,end_counter)%ght(3) + GHTCNT4(:) = cat_progn(:,end_counter)%ght(4) + GHTCNT5(:) = cat_progn(:,end_counter)%ght(5) + GHTCNT6(:) = cat_progn(:,end_counter)%ght(6) - WESNN1(:) = cat_progn(:,ens_id)%wesn(1) - WESNN2(:) = cat_progn(:,ens_id)%wesn(2) - WESNN3(:) = cat_progn(:,ens_id)%wesn(3) + WESNN1(:) = cat_progn(:,end_counter)%wesn(1) + WESNN2(:) = cat_progn(:,end_counter)%wesn(2) + WESNN3(:) = cat_progn(:,end_counter)%wesn(3) - HTSNNN1(:) = cat_progn(:,ens_id)%htsn(1) - HTSNNN2(:) = cat_progn(:,ens_id)%htsn(2) - HTSNNN3(:) = cat_progn(:,ens_id)%htsn(3) + HTSNNN1(:) = cat_progn(:,end_counter)%htsn(1) + HTSNNN2(:) = cat_progn(:,end_counter)%htsn(2) + HTSNNN3(:) = cat_progn(:,end_counter)%htsn(3) - SNDZN1(:) = cat_progn(:,ens_id)%sndz(1) - SNDZN2(:) = cat_progn(:,ens_id)%sndz(2) - SNDZN3(:) = cat_progn(:,ens_id)%sndz(3) + SNDZN1(:) = cat_progn(:,end_counter)%sndz(1) + SNDZN2(:) = cat_progn(:,end_counter)%sndz(2) + SNDZN3(:) = cat_progn(:,end_counter)%sndz(3) - if(ens_id == NUM_ENSEMBLE ) ens_id = 0 + if(end_counter == NUM_ENSEMBLE ) ens_counter = 0 ! End RETURN_(ESMF_SUCCESS) From c2685c7393f961f9eda143964501fce9879c3d18 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sat, 16 May 2020 15:53:19 -0400 Subject: [PATCH 12/19] correct typo --- .../GEOS_LandAssimGridComp.F90 | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index f4e5be72..964ebb2a 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -1836,7 +1836,7 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) real, dimension(:), pointer :: SNDZN2 real, dimension(:), pointer :: SNDZN3 - integer, save :: end_counter = 0 + integer, save :: ens_counter = 0 !BOP @@ -1897,43 +1897,43 @@ subroutine UPDATE_ASSIM(gc, import, export, clock, rc) _VERIFY(status) ! This counter is relative to ens_id - end_counter = ens_counter + 1 + ens_counter = ens_counter + 1 !distribute catch_progn - TC(:,1) = cat_progn(:,end_counter)%tc1 - TC(:,2) = cat_progn(:,end_counter)%tc2 - TC(:,3) = cat_progn(:,end_counter)%tc4 + TC(:,1) = cat_progn(:,ens_counter)%tc1 + TC(:,2) = cat_progn(:,ens_counter)%tc2 + TC(:,3) = cat_progn(:,ens_counter)%tc4 - QC(:,1) = cat_progn(:,end_counter)%qa1 - QC(:,2) = cat_progn(:,end_counter)%qa2 - QC(:,3) = cat_progn(:,end_counter)%qa4 + QC(:,1) = cat_progn(:,ens_counter)%qa1 + QC(:,2) = cat_progn(:,ens_counter)%qa2 + QC(:,3) = cat_progn(:,ens_counter)%qa4 - CAPAC(:) = cat_progn(:,end_counter)%capac + CAPAC(:) = cat_progn(:,ens_counter)%capac - CATDEF(:) = cat_progn(:,end_counter)%catdef - RZEXC(:) = cat_progn(:,end_counter)%rzexc - SRFEXC(:) = cat_progn(:,end_counter)%srfexc + CATDEF(:) = cat_progn(:,ens_counter)%catdef + RZEXC(:) = cat_progn(:,ens_counter)%rzexc + SRFEXC(:) = cat_progn(:,ens_counter)%srfexc - GHTCNT1(:) = cat_progn(:,end_counter)%ght(1) - GHTCNT2(:) = cat_progn(:,end_counter)%ght(2) - GHTCNT3(:) = cat_progn(:,end_counter)%ght(3) - GHTCNT4(:) = cat_progn(:,end_counter)%ght(4) - GHTCNT5(:) = cat_progn(:,end_counter)%ght(5) - GHTCNT6(:) = cat_progn(:,end_counter)%ght(6) + GHTCNT1(:) = cat_progn(:,ens_counter)%ght(1) + GHTCNT2(:) = cat_progn(:,ens_counter)%ght(2) + GHTCNT3(:) = cat_progn(:,ens_counter)%ght(3) + GHTCNT4(:) = cat_progn(:,ens_counter)%ght(4) + GHTCNT5(:) = cat_progn(:,ens_counter)%ght(5) + GHTCNT6(:) = cat_progn(:,ens_counter)%ght(6) - WESNN1(:) = cat_progn(:,end_counter)%wesn(1) - WESNN2(:) = cat_progn(:,end_counter)%wesn(2) - WESNN3(:) = cat_progn(:,end_counter)%wesn(3) + WESNN1(:) = cat_progn(:,ens_counter)%wesn(1) + WESNN2(:) = cat_progn(:,ens_counter)%wesn(2) + WESNN3(:) = cat_progn(:,ens_counter)%wesn(3) - HTSNNN1(:) = cat_progn(:,end_counter)%htsn(1) - HTSNNN2(:) = cat_progn(:,end_counter)%htsn(2) - HTSNNN3(:) = cat_progn(:,end_counter)%htsn(3) + HTSNNN1(:) = cat_progn(:,ens_counter)%htsn(1) + HTSNNN2(:) = cat_progn(:,ens_counter)%htsn(2) + HTSNNN3(:) = cat_progn(:,ens_counter)%htsn(3) - SNDZN1(:) = cat_progn(:,end_counter)%sndz(1) - SNDZN2(:) = cat_progn(:,end_counter)%sndz(2) - SNDZN3(:) = cat_progn(:,end_counter)%sndz(3) + SNDZN1(:) = cat_progn(:,ens_counter)%sndz(1) + SNDZN2(:) = cat_progn(:,ens_counter)%sndz(2) + SNDZN3(:) = cat_progn(:,ens_counter)%sndz(3) - if(end_counter == NUM_ENSEMBLE ) ens_counter = 0 + if(ens_counter == NUM_ENSEMBLE ) ens_counter = 0 ! End RETURN_(ESMF_SUCCESS) From 7259744287596ee2d6589abe1c4aa0220f9b7801 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sat, 16 May 2020 16:50:14 -0400 Subject: [PATCH 13/19] fix type --- src/Applications/LDAS_App/ldas_setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 5a79ad30..9c619395 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -138,7 +138,7 @@ class LDASsetup: _mydir = self.exphome + '/' + self.rqdExeInp['EXP_ID'] assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None - _first_ens_id = self.rqdExeInp.get('FIRST_ENS_ID',0) + _first_ens_id = int(self.rqdExeInp.get('FIRST_ENS_ID',0)) self.ensdirs = ['ens%04d'%iens for iens in xrange( _first_ens_id, self.nens + _first_ens_id)] self.ensids = ['%04d'%iens for iens in xrange(_first_ens_id, self.nens + _first_ens_id)] if (self.nens == 1) : From 8846529df3a8c1af5e654298558609cfd6ed6c4e Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sun, 17 May 2020 09:54:20 -0400 Subject: [PATCH 14/19] further clean up --- src/Applications/LDAS_App/ldas_setup | 39 +++++++------------ .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 2 +- .../GEOS_LandAssimGridComp.F90 | 2 +- 3 files changed, 15 insertions(+), 28 deletions(-) diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 9c619395..130ce18d 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -82,6 +82,8 @@ class LDASsetup: assert os.path.isdir(self.exphome) # exphome should exist self.verbose = cmdLineArgs['verbose'] self.runmodel = cmdLineArgs['runmodel'] + if self.runmodel : + print('\n The option "--runmodel" is out of date, not necessary anymore. \n') self.daysperjob = cmdLineArgs['daysperjob'] self.monthsperjob = cmdLineArgs['monthsperjob'] self.rqdExeInp = OrderedDict() @@ -97,6 +99,7 @@ class LDASsetup: self.islocal = False self.catch = '' self.has_mwrtm = False + self.assim = False self.has_landassim_seed = False self.has_geos_pert = False self.has_ldassa_pert = False @@ -351,15 +354,14 @@ class LDASsetup: self.has_ldassa_pert = True # DEAL WITH mwRTM input from exec - _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 - if _assim == 0 : - _result = self.rqdExeInp.pop('MWRTM_FILE', None) - - + self.assim = Ture if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else False + # verify mwrtm file if 'MWRTM_FILE' in self.rqdExeInp : _tmpfile = self.rqdExeInp['MWRTM_FILE'].replace("'",'').replace('"','') if os.path.isfile(_tmpfile) : assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'if MWRTM_FILE is specified,it should be global' + self.has_mwrtm = True + self.rqdExeInp['MWRTM_FILE'] = _tmpfile else : assert not _tmpfile.strip(), ' MWRTM_FILE: %s should point to mwrtm param file'% _tmpfile del self.rqdExeInp['MWRTM_FILE'] @@ -713,7 +715,7 @@ class LDASsetup: _ensdir = self.ensdirs[iens] _ensid = self.ensids[iens] landassim_seeds = rstpath + _ensdir + '/' + y4m2+'/' + rstid + '.landassim_obspertrseed_rst.'+y4m2d2_h2m2 - if os.path.isfile(landassim_seeds) and self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' : + if os.path.isfile(landassim_seeds) and self.assim : _seeds = self.rstdir + _ensdir + '/' + y4m2+'/' + exp_id + '.landassim_obspertrseed_rst.'+y4m2d2_h2m2 shutil.copy(landassim_seeds, _seeds) os.symlink(_seeds, myRstDir+ '/landassim_obspertrseed'+ _ensid +'_rst') @@ -834,16 +836,8 @@ class LDASsetup: 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 - # mwRTM restart file - mwRTMRstFile = "" - #_assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 - if 'MWRTM_FILE' in self.rqdExeInp : + if self.has_mwrtm : mwRTMRstFile = self.rqdExeInp['MWRTM_FILE'] - #elif _assim ==1 : - # mwRTMRstFile= rcoutpath +'/' + y4m2+'/'+self.rqdExeInp['RESTART_ID']+'.ldas_mwRTMparam.'+y4m2d2_h2m2+'z.nc4' - - if os.path.isfile(mwRTMRstFile) : - self.has_mwrtm = True mwRTMLocal = self.bcsdir+'/'+ y4m2+'/'+self.rqdExeInp['EXP_ID']+'.ldas_mwRTMparam.'+y4m2d2_h2m2+'z.nc4' if self.islocal : print "Creating the local mwRTM restart file... \n" @@ -964,7 +958,7 @@ class LDASsetup: GRID='EASE ' + self.rqdExeInp['GRIDNAME'] + ' ' +tmprcfile if '-CF' in self.rqdExeInp['GRIDNAME'] : GRID ='CUBE ' + self.rqdExeInp['GRIDNAME'] + ' ' +tmprcfile - _assim = '1' if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else '0' + _assim = '1' if self.assim else '0' _perturb = '1' if self.nens > 1 else '0' cmd ='./process_hist.csh '+ str(self.rqdExeInp['LSM_CHOICE']) + ' ' + str(self.rqdExeInp['AEROSOL_DEPOSITION']) + \ ' ' + GRID + ' ' + str(self.rqdExeInp['RUN_IRRIG']) + ' ' + _assim + ' '+ _perturb @@ -1013,12 +1007,6 @@ class LDASsetup: #for key,val in optinxny.iteritems(): # ldasrcInp[key]= val - - if (self.runmodel) : - assert ldasrcInp['LAND_ASSIM'].upper() == 'NO', "--runmodel is used,should set LAND_ASSIM to NO" - else : - assert ldasrcInp['LAND_ASSIM'].upper() == 'YES', "--runmodel is not used,should set LAND_ASSIM to YES" - # create BC in rc file tmpl_ = '' if self.nens >1 : @@ -1050,18 +1038,17 @@ class LDASsetup: rstkey=[catch_,'VEGDYN','LANDPERT'] rstval=[self.catch,'vegdyn','landpert'] - _assim = 1 if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else 0 if self.has_mwrtm : # and _assim ==1 : keyn='LANDASSIM_INTERNAL_RESTART_FILE' valn='../input/restart/mwrtm_param_rst' ldasrcInp[keyn]= valn - if self.has_landassim_seed and _assim ==1 : + if self.has_landassim_seed and self.assim : keyn='LANDASSIM_OBSPERTRSEED_RESTART_FILE' valn='../input/restart/landassim_obspertrseed%s_rst' ldasrcInp[keyn]= valn - if _assim == 1: + if self.assim: keyn='LANDASSIM_OBSPERTRSEED_CHECKPOINT_FILE' valn='landassim_obspertrseed%s_checkpoint' ldasrcInp[keyn]= valn @@ -1550,7 +1537,7 @@ def parseCmdLine(): ) p_setup.add_argument( '--runmodel', - help='model run (no assimilation)', + help='obsolete, no effect any more', action='store_true', ) p_setup.add_argument( diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index 0089c48e..7de689e9 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -164,7 +164,7 @@ subroutine SetServices(gc, rc) VERIFY_(STATUS) land_assim = (trim(LAND_ASSIM_STR) /= 'NO') - call MAPL_GetResource ( MAPL, mwRTM_file, Label="MWRTM_FILE:", DEFAULT='', RC=STATUS) + call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) mwRTM = ( len_trim(mwRTM_file) /= 0 ) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 964ebb2a..6d5e8db8 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -157,7 +157,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) land_assim = (trim(LAND_ASSIM_STR) /= 'NO') - call MAPL_GetResource ( MAPL, mwRTM_file, Label="MWRTM_FILE:", DEFAULT='', RC=STATUS) + call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) mwRTM = ( len_trim(mwRTM_file) /= 0 ) From 4c9a170354bcf7c0d84a0577c88010a0f1cf56bf Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sun, 17 May 2020 14:06:40 -0400 Subject: [PATCH 15/19] correct typo --- src/Applications/LDAS_App/ldas_setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 130ce18d..32a6598e 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -354,7 +354,7 @@ class LDASsetup: self.has_ldassa_pert = True # DEAL WITH mwRTM input from exec - self.assim = Ture if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else False + self.assim = True if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else False # verify mwrtm file if 'MWRTM_FILE' in self.rqdExeInp : _tmpfile = self.rqdExeInp['MWRTM_FILE'].replace("'",'').replace('"','') From 8daf3545f1817b8f9c776557ce464b50968b45a8 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Mon, 18 May 2020 10:49:00 -0400 Subject: [PATCH 16/19] additional edits and comments - first_ens_id fixes - replaced "xrange" with "range" in ldas_setup (--> Python 3) - minor cleanup --- src/Applications/LDAS_App/ldas_setup | 20 ++++--- .../GEOSldas_GridComp/GEOS_LdasGridComp.F90 | 14 +---- .../GEOS_LandPertGridComp.F90 | 50 ++++++++-------- .../LDAS_PertRoutines.F90 | 58 ++----------------- 4 files changed, 45 insertions(+), 97 deletions(-) diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 32a6598e..826c9a69 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -142,8 +142,8 @@ class LDASsetup: assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None _first_ens_id = int(self.rqdExeInp.get('FIRST_ENS_ID',0)) - self.ensdirs = ['ens%04d'%iens for iens in xrange( _first_ens_id, self.nens + _first_ens_id)] - self.ensids = ['%04d'%iens for iens in xrange(_first_ens_id, self.nens + _first_ens_id)] + self.ensdirs = ['ens%04d'%iens for iens in range(_first_ens_id, self.nens - 1 + _first_ens_id)] + self.ensids = ['%04d'%iens for iens in range(_first_ens_id, self.nens - 1 + _first_ens_id)] if (self.nens == 1) : self.ensdirs_avg = self.ensdirs self.ensids=[''] @@ -359,7 +359,11 @@ class LDASsetup: if 'MWRTM_FILE' in self.rqdExeInp : _tmpfile = self.rqdExeInp['MWRTM_FILE'].replace("'",'').replace('"','') if os.path.isfile(_tmpfile) : - assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'if MWRTM_FILE is specified,it should be global' + # I DO NOT UNDERSTAND THE FOLLOWING LINE + # I UNDERSTAND THAT THE SPECIFIED MWRTM_FILE MUST BE FOR THE GLOBAL DOMAIN + # IF THE EXPERIMENT DOMAIN IS NOT GLOBAL, A REGIONAL MWRTM_FILE WILL BE CREATED BY preprocess_ldas.x, RIGHT? + # WHAT I DO NOT UNDERSTAND IS HOW THE assert IN THE FOLLOWING LINE DETERMINES WHETHER MWRTM_FILE IS INDEED GLOBAL + assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'if MWRTM_FILE is specified, the file should be global' self.has_mwrtm = True self.rqdExeInp['MWRTM_FILE'] = _tmpfile else : @@ -534,7 +538,7 @@ class LDASsetup: # ensxxxx directories nSegments = self.nSegments - for iseg in xrange(nSegments): + for iseg in range(nSegments): _start = self.begDates[iseg] _end = self.endDates[iseg] @@ -632,7 +636,7 @@ class LDASsetup: sp.call(cmd,shell=True) # check if it is local or global with open('f2g.txt') as f2gfile : - head=[next(f2gfile) for x in xrange(2)] + head=[next(f2gfile) for x in range(2)] if(head[0].strip() != head[1].strip()) : self.islocal= True @@ -711,7 +715,7 @@ class LDASsetup: rstpath0 = self.rqdExeInp['RESTART_PATH'] # just copy the landassim pert seed if it exists - for iens in xrange(self.nens) : + for iens in range(self.nens) : _ensdir = self.ensdirs[iens] _ensid = self.ensids[iens] landassim_seeds = rstpath + _ensdir + '/' + y4m2+'/' + rstid + '.landassim_obspertrseed_rst.'+y4m2d2_h2m2 @@ -742,7 +746,7 @@ class LDASsetup: #for ens in self.ensdirs : catchRstFile0 = '' vegdynRstFile0 = '' - for iens in xrange(self.nens) : + for iens in range(self.nens) : ens = self.ensdirs[iens] ensid = self.ensids[iens] myCatchRst = myRstDir+'/'+self.catch +ensid +'_internal_rst' @@ -1158,7 +1162,7 @@ class LDASsetup: expid = self.rqdExeInp['EXP_ID'] fout.write("\nsed -i 's/if($capdate<$enddate) sbatch /#if($capdate<$enddate) sbatch /g' lenkf.j\n\n") nSegments = self.nSegments - for iseg in xrange(nSegments): + for iseg in range(nSegments): if iseg ==0 : fout.write("jobid%d=$(echo $(sbatch lenkf.j) | cut -d' ' -f 4)\n"%(iseg)) fout.write("echo $jobid%d\n"%iseg ) diff --git a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 index 7de689e9..ff8dd319 100644 --- a/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOS_LdasGridComp.F90 @@ -146,18 +146,6 @@ subroutine SetServices(gc, rc) call MAPL_GetResource ( MAPL, FIRST_ENS_ID, Label="FIRST_ENS_ID:", DEFAULT=0, RC=STATUS) VERIFY_(STATUS) - ! ^^^^^^^^^^^^^^^^^^^^^ CLEAN UP THE FOLLOWING COMMENTS WHEN WE ARE DONE WITH THE EDITS HERE. - ! - ! THE CHANGES HERE ARE AN ATTEMPT TO AVOID CHANGING THE INTERFACE - ! 1) keep the LAND_ASSIM resource parameter a string (Yes/No) - ! 2) use the MWRTM_FILE resource parameter to set the local logical mwRTM - ! --> if MWRTM_FILE is an empty string, mwRTM=.false., otherwise mwRTM=.true. - ! that is... if the user does NOT provide this file, don't attempt to compute Tbs; - ! if the user provides this file, go ahead and attempt to compute Tbs, still check "all_nodata" later) - ! I think with these changes we no longer need to change "ldas_setup". - ! (But it might still be good to clean up "--runmodel"...) - ! IMPORTANT: I'm not sure the new lines below for "mwRTM" are quite correct. Please double-check carefully!!! - ! 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) @@ -170,7 +158,7 @@ subroutine SetServices(gc, rc) call MAPL_GetResource ( MAPL, LSM_CHOICE, Label="LSM_CHOICE:", DEFAULT=1, RC=STATUS) if (LSM_CHOICE /=1 ) then - _ASSERT( .not. (mwRTM .or. land_assim), "CATCHCN is Not Ready for assimilation or mwRTM") + _ASSERT( .not. (mwRTM .or. land_assim), "CatchCN is Not Ready for assimilation or mwRTM") endif METFORCE = MAPL_AddChild(gc, name='METFORCE', ss=MetforceSetServices, rc=status) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 index f3af95b1..4d540e0d 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 @@ -115,7 +115,7 @@ subroutine SetServices(gc, rc) call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & - Phase2_Initialize, & + Phase2_Initialize, & rc=status & ) VERIFY_(status) @@ -184,6 +184,8 @@ subroutine SetServices(gc, rc) call MAPL_GetResource(MAPL, GEOSldas_FIRST_ENS_ID, 'FIRST_ENS_ID:',DEFAULT=0, rc=status) VERIFY_(status) + ! reichle, 18 May 2020: The following probably works only if FIRST_ENS_ID=0. + ! Need to distinguish between ens_id and ens_counter? ens_id = 0 if ( internal%NUM_ENSEMBLE > 1) then !landpertxxxx @@ -1085,8 +1087,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) endif - - if (IAmRoot .and. internal%ens_id == 0) then + if (IAmRoot .and. internal%ens_id == 0) then ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter call echo_pert_param( internal%ForcePert%npert, internal%ForcePert%param, 1, 1 ) call echo_pert_param( internal%PrognPert%npert, internal%PrognPert%param, 1, 1 ) endif @@ -1107,9 +1108,9 @@ subroutine Initialize(gc, import, export, clock, rc) ! Coldstart if (COLDSTART) then - if (IAmRoot .and. internal%ens_id == 0 ) print *, trim(Iam)//'::WARNING: Cold-starting LandPert GridComp' + if (IAmRoot .and. internal%ens_id == 0 ) print *, trim(Iam)//'::WARNING: Cold-starting LandPert GridComp' ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter ! -pert_rseed- - call get_init_pert_rseed(internal%ens_id, pert_rseed(1)) + call get_init_pert_rseed(internal%ens_id, pert_rseed(1)) ! reichle, 18 May 2020: ens_id vs. ens_counter ?? call init_randseed(pert_rseed) ! -ForcePert- call propagate_pert( & @@ -1141,25 +1142,25 @@ subroutine Initialize(gc, import, export, clock, rc) end if - if(internal%ens_id ==0 ) fpert_enavg(:,:,:)=0. + if(internal%ens_id ==0 ) fpert_enavg(:,:,:)=0. ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter do m = 1,internal%ForcePert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), fpert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%ForcePert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then fpert_enavg(:,:,m)=fpert_enavg(:,:,m)+fpert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then + if( internal%ens_id == internal%NUM_ENSEMBLE-1) then ! reichle, 18 May 2020: "%ens_counter=="?? ens_id vs. ens_counter fpert_enavg(:,:,m) = -fpert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif enddo - if(internal%ens_id ==0 ) ppert_enavg(:,:,:)=0. + if(internal%ens_id ==0 ) ppert_enavg(:,:,:)=0. ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter do m = 1,internal%PrognPert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), ppert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%PrognPert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then ppert_enavg(:,:,m)=ppert_enavg(:,:,m)+ppert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then + if( internal%ens_id == internal%NUM_ENSEMBLE-1) then ! reichle, 18 May 2020: "%ens_counter=="?? ens_id vs. ens_counter ppert_enavg(:,:,m) = -ppert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1184,7 +1185,7 @@ subroutine Initialize(gc, import, export, clock, rc) call esmf2ldas(StopTime, stop_time, rc=status) VERIFY_(status) - if( internal%ens_id ==0 .and. IAmRoot) then + if( internal%ens_id ==0 .and. IAmRoot) then ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter ! write out the input file call read_ens_prop_inputs(write_nml = .true. , work_path = trim(out_path), & exp_id = trim(exp_id), date_time = start_time) @@ -1233,7 +1234,7 @@ subroutine Initialize(gc, import, export, clock, rc) ! Update the r4 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_KIND_R8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter"?? ens_id vs. ens_counter ! Clean up if (allocated(pert_rseed)) then ! integer version of MINTERNAL state @@ -1377,7 +1378,8 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) allocate(ppert_grid(n_lon,n_lat, internal%PrognPert%npert), source=MAPL_UNDEF, stat=status) VERIFY_(status) - ! Get pertubations on the underlying grid and convert grid data to tile data + ! Get pertubations on the underlying grid and convert grid data to tile data, adjust mean + ! ! -ForcePert- fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert)= fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert) + & @@ -1448,7 +1450,7 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter"?? ens_id vs. ens_counter ! Clean up if (allocated(fpert_grid)) then @@ -1468,7 +1470,7 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) call MAPL_TimerOff(MAPL, "phase2_Initialize") call MAPL_TimerOff(MAPL, "TOTAL") - if(internal%ens_id == internal%NUM_ENSEMBLE -1) phase2_initialized = .true. + if(internal%ens_id == internal%NUM_ENSEMBLE -1) phase2_initialized = .true. ! reichle, 18 May 2020: "%ens_counter"?? ens_id vs. ens_counter ! End RETURN_(ESMF_SUCCESS) @@ -1644,7 +1646,7 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) call MAPL_DateStampGet(clock, datestamp, rc=status) VERIFY_(STATUS) - write(id_string,'(I4.4)') internal%ens_id + write(id_string,'(I4.4)') internal%ens_id ! reichle, 18 May 2020: ens_id vs. ens_counter ?? if(internal%NUM_ENSEMBLE ==1 ) id_string='' chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint.'//datestamp @@ -1667,13 +1669,13 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) .false. & ) - if(internal%ens_id ==0 ) fpert_enavg(:,:,:)=0. + if(internal%ens_id ==0 ) fpert_enavg(:,:,:)=0. ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next do m = 1,internal%ForcePert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), fpert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%ForcePert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then fpert_enavg(:,:,m)=fpert_enavg(:,:,m)+fpert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then + if( internal%ens_id == internal%NUM_ENSEMBLE-1) then ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next fpert_enavg(:,:,m) = -fpert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1694,13 +1696,13 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) .false. & ) - if(internal%ens_id ==0 ) ppert_enavg(:,:,:)=0. + if(internal%ens_id ==0 ) ppert_enavg(:,:,:)=0. ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next do m = 1,internal%PrognPert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), ppert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%PrognPert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then ppert_enavg(:,:,m)=ppert_enavg(:,:,m)+ppert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE -1) then + if( internal%ens_id == internal%NUM_ENSEMBLE -1) then ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next ppert_enavg(:,:,m) = -ppert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1710,7 +1712,7 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) endif ! Update the r4 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_KIND_R8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? call MAPL_TimerOff(MAPL, "GenerateRaw") ! End @@ -2168,7 +2170,7 @@ subroutine ApplyForcePert(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed if (internal%PERTURBATIONS /=0 ) then pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? endif ! Clean up @@ -2559,7 +2561,7 @@ subroutine ApplyPrognPert(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed + pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? ! Clean up if (allocated(PROGNPERT)) then @@ -2631,7 +2633,7 @@ subroutine Update_pert_rseed(gc,import,export,clock,rc) VERIFY_(status) endif - pert_rseed_r8(:) = real(pert_iseed(:,internal%ens_id+1),kind=ESMF_KIND_R8) + pert_rseed_r8(:) = real(pert_iseed(:,internal%ens_id+1),kind=ESMF_KIND_R8) ! reichle, 18 May 2020: "%ens_counter" ?? ! End RETURN_(ESMF_SUCCESS) @@ -2757,7 +2759,7 @@ subroutine Finalize(gc, import, export, clock, rc) enddo ! 4) writing - write(id_string,'(I4.4)') internal%ens_id + write(id_string,'(I4.4)') internal%ens_id ! reichle, 18 May 2020: ens_id vs. ens_counter ?? if(internal%NUM_ENSEMBLE ==1 ) id_string='' chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint' diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 index efb254d9..57907ad3 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 @@ -117,24 +117,17 @@ module LDAS_PertRoutinesMod private public :: read_ens_prop_inputs - ! CHANGED: we do not need get_tile_pert any more - ! public :: get_tile_pert public :: interpolate_pert_to_timestep - ! public :: apply_progn_pert - ! public :: apply_force_pert public :: get_pert_grid public :: get_progn_pert_param public :: get_force_pert_param public :: echo_pert_param - ! CHANGED :: io_pert_rstrt() removed - use MAPL to read internal rst vars ! WY note :: io_pert_rstrt() was adapted. read from LDASsa and write to a nc4 file as MAPL internal public :: io_pert_rstrt - ! CHANGED: we do not need initialize_perturbations any more - ! public :: initialize_perturbations public :: check_pert_dtstep ! ADDED public :: apply_pert - ! the parameters below will be overriteted by RC file + ! the parameters below will be overwritten by RC file integer,public :: GEOSldas_NUM_ENSEMBLE = -1 integer,public :: GEOSldas_FIRST_ENS_ID = -1 integer,public :: GEOSldas_FORCE_PERT_DTSTEP = -1 @@ -408,53 +401,14 @@ subroutine read_ens_prop_inputs( & read (10, nml=ens_prop_inputs) close(10,status='keep') endif - if( GEOSldas_NUM_ENSEMBLE == -1 .or. GEOSldas_FIRST_ENS_ID==-1 & + if( GEOSldas_NUM_ENSEMBLE == -1 .or. GEOSldas_FIRST_ENS_ID == -1 & .or. GEOSldas_FORCE_PERT_DTSTEP == -1 .or. GEOSldas_PROGN_PERT_DTSTEP == -1 ) then stop " GEOSldas_NUM_ENSEMBLE etc. should be initialized" endif - N_ens = GEOSldas_NUM_ENSEMBLE - first_ens_id = GEOSldas_FIRST_ENS_ID - force_pert_dtstep =GEOSldas_FORCE_PERT_DTSTEP - progn_pert_dtstep =GEOSldas_PROGN_PERT_DTSTEP - - ! CHANGED: Getting rid of ability to read ensprop path and file from command line - ! ! Get name and path for special ens prop inputs file from - ! ! command line (if present) - - ! ens_prop_inputs_path = '' - ! ens_prop_inputs_file = '' - - ! call clsm_ensdrv_get_command_line( & - ! ens_prop_inputs_path=ens_prop_inputs_path, & - ! ens_prop_inputs_file=ens_prop_inputs_file ) - - ! if ( trim(ens_prop_inputs_path) /= '' .and. & - ! trim(ens_prop_inputs_file) /= '' ) then - - ! ! Read data from special ens prop inputs namelist file - - ! fname = trim(ens_prop_inputs_path) // '/' // trim(ens_prop_inputs_file) - - ! open (10, file=fname, delim='apostrophe', action='read', status='old') - - ! if (logit) write (logunit,*) - ! if (logit) write (logunit,'(400A)') 'reading *special* ens prop inputs from ' // trim(fname) - ! if (logit) write (logunit,*) - - ! read (10, nml=ens_prop_inputs) - - ! close(10,status='keep') - - ! end if - - ! over write ens prop from the test file - ! overwrite ens prop inputs with command line options, if any - - ! write (logunit,*) 'overwriting driver inputs from command line (if present)' - ! write (logunit,*) - - ! CHANGED: Not reading N_ens and first_ens_id from command line - ! call clsm_ensdrv_get_command_line( N_ens=N_ens, first_ens_id=first_ens_id ) + N_ens = GEOSldas_NUM_ENSEMBLE + first_ens_id = GEOSldas_FIRST_ENS_ID + force_pert_dtstep = GEOSldas_FORCE_PERT_DTSTEP + progn_pert_dtstep = GEOSldas_PROGN_PERT_DTSTEP ! echo variables of ens_prop_inputs From cbfc86bf9fdbbbd0e88dc41440cd043bef81b007 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 18 May 2020 14:23:26 -0400 Subject: [PATCH 17/19] fix ens_id in landpert grid comp. Firther cleanup --- src/Applications/LDAS_App/ldas_setup | 11 ++--- .../GEOS_LandPertGridComp.F90 | 44 +++++++++---------- 2 files changed, 26 insertions(+), 29 deletions(-) diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 826c9a69..6865dd99 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -142,8 +142,8 @@ class LDASsetup: assert not os.path.isdir(_mydir), 'Dir [%s] already exists!' % _mydir _mydir = None _first_ens_id = int(self.rqdExeInp.get('FIRST_ENS_ID',0)) - self.ensdirs = ['ens%04d'%iens for iens in range(_first_ens_id, self.nens - 1 + _first_ens_id)] - self.ensids = ['%04d'%iens for iens in range(_first_ens_id, self.nens - 1 + _first_ens_id)] + self.ensdirs = ['ens%04d'%iens for iens in range(_first_ens_id, self.nens + _first_ens_id)] + self.ensids = ['%04d'%iens for iens in range(_first_ens_id, self.nens + _first_ens_id)] if (self.nens == 1) : self.ensdirs_avg = self.ensdirs self.ensids=[''] @@ -355,15 +355,12 @@ class LDASsetup: # DEAL WITH mwRTM input from exec self.assim = True if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else False + if (self.assim) : + assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'So far, only global datat assimilation is supported' # verify mwrtm file if 'MWRTM_FILE' in self.rqdExeInp : _tmpfile = self.rqdExeInp['MWRTM_FILE'].replace("'",'').replace('"','') if os.path.isfile(_tmpfile) : - # I DO NOT UNDERSTAND THE FOLLOWING LINE - # I UNDERSTAND THAT THE SPECIFIED MWRTM_FILE MUST BE FOR THE GLOBAL DOMAIN - # IF THE EXPERIMENT DOMAIN IS NOT GLOBAL, A REGIONAL MWRTM_FILE WILL BE CREATED BY preprocess_ldas.x, RIGHT? - # WHAT I DO NOT UNDERSTAND IS HOW THE assert IN THE FOLLOWING LINE DETERMINES WHETHER MWRTM_FILE IS INDEED GLOBAL - assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'if MWRTM_FILE is specified, the file should be global' self.has_mwrtm = True self.rqdExeInp['MWRTM_FILE'] = _tmpfile else : diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 index 4d540e0d..f51b903f 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 @@ -69,6 +69,7 @@ module GEOS_LandPertGridCompMod integer,dimension(:,:),pointer,public :: pert_iseed=>null() integer :: lat1, lat2, lon1, lon2 + integer :: FIRST_ENS_ID contains !BOP @@ -184,9 +185,8 @@ subroutine SetServices(gc, rc) call MAPL_GetResource(MAPL, GEOSldas_FIRST_ENS_ID, 'FIRST_ENS_ID:',DEFAULT=0, rc=status) VERIFY_(status) - ! reichle, 18 May 2020: The following probably works only if FIRST_ENS_ID=0. - ! Need to distinguish between ens_id and ens_counter? - ens_id = 0 + FIRST_ENS_ID = GEOSldas_FIRST_ENS_ID + ens_id = FIRST_ENS_ID if ( internal%NUM_ENSEMBLE > 1) then !landpertxxxx read(comp_name(9:12),*) ens_id @@ -1087,7 +1087,7 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) endif - if (IAmRoot .and. internal%ens_id == 0) then ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter + if (IAmRoot .and. internal%ens_id == FIRST_ENS_ID) then call echo_pert_param( internal%ForcePert%npert, internal%ForcePert%param, 1, 1 ) call echo_pert_param( internal%PrognPert%npert, internal%PrognPert%param, 1, 1 ) endif @@ -1108,9 +1108,9 @@ subroutine Initialize(gc, import, export, clock, rc) ! Coldstart if (COLDSTART) then - if (IAmRoot .and. internal%ens_id == 0 ) print *, trim(Iam)//'::WARNING: Cold-starting LandPert GridComp' ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter + if (IAmRoot .and. internal%ens_id == FIRST_ENS_ID ) print *, trim(Iam)//'::WARNING: Cold-starting LandPert GridComp' ! -pert_rseed- - call get_init_pert_rseed(internal%ens_id, pert_rseed(1)) ! reichle, 18 May 2020: ens_id vs. ens_counter ?? + call get_init_pert_rseed(internal%ens_id, pert_rseed(1)) call init_randseed(pert_rseed) ! -ForcePert- call propagate_pert( & @@ -1142,25 +1142,25 @@ subroutine Initialize(gc, import, export, clock, rc) end if - if(internal%ens_id ==0 ) fpert_enavg(:,:,:)=0. ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter + if(internal%ens_id == FIRST_ENS_ID ) fpert_enavg(:,:,:)=0. do m = 1,internal%ForcePert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), fpert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%ForcePert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then fpert_enavg(:,:,m)=fpert_enavg(:,:,m)+fpert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then ! reichle, 18 May 2020: "%ens_counter=="?? ens_id vs. ens_counter + if( internal%ens_id-FIRST_ENS_ID == internal%NUM_ENSEMBLE-1) then fpert_enavg(:,:,m) = -fpert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif enddo - if(internal%ens_id ==0 ) ppert_enavg(:,:,:)=0. ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter + if(internal%ens_id == FIRST_ENS_ID) ppert_enavg(:,:,:)=0. do m = 1,internal%PrognPert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), ppert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%PrognPert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then ppert_enavg(:,:,m)=ppert_enavg(:,:,m)+ppert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then ! reichle, 18 May 2020: "%ens_counter=="?? ens_id vs. ens_counter + if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE-1) then ppert_enavg(:,:,m) = -ppert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1185,7 +1185,7 @@ subroutine Initialize(gc, import, export, clock, rc) call esmf2ldas(StopTime, stop_time, rc=status) VERIFY_(status) - if( internal%ens_id ==0 .and. IAmRoot) then ! reichle, 18 May 2020: "==FIRST_ENS_ID"?? ens_id vs. ens_counter + if( internal%ens_id == FIRST_ENS_ID .and. IAmRoot) then ! write out the input file call read_ens_prop_inputs(write_nml = .true. , work_path = trim(out_path), & exp_id = trim(exp_id), date_time = start_time) @@ -1234,7 +1234,7 @@ subroutine Initialize(gc, import, export, clock, rc) ! Update the r4 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_KIND_R8) - pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter"?? ens_id vs. ens_counter + pert_iseed(:,internal%ens_id + 1 - FIRST_ENS_ID ) = pert_rseed ! Clean up if (allocated(pert_rseed)) then ! integer version of MINTERNAL state @@ -1450,7 +1450,7 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter"?? ens_id vs. ens_counter + pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed ! Clean up if (allocated(fpert_grid)) then @@ -1470,7 +1470,7 @@ subroutine Phase2_Initialize(gc, import, export, clock, rc) call MAPL_TimerOff(MAPL, "phase2_Initialize") call MAPL_TimerOff(MAPL, "TOTAL") - if(internal%ens_id == internal%NUM_ENSEMBLE -1) phase2_initialized = .true. ! reichle, 18 May 2020: "%ens_counter"?? ens_id vs. ens_counter + if(internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE -1) phase2_initialized = .true. ! End RETURN_(ESMF_SUCCESS) @@ -1669,13 +1669,13 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) .false. & ) - if(internal%ens_id ==0 ) fpert_enavg(:,:,:)=0. ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next + if(internal%ens_id == FIRST_ENS_ID ) fpert_enavg(:,:,:)=0. ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next do m = 1,internal%ForcePert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), fpert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%ForcePert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then fpert_enavg(:,:,m)=fpert_enavg(:,:,m)+fpert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE-1) then ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next + if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE-1) then ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next fpert_enavg(:,:,m) = -fpert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1696,13 +1696,13 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) .false. & ) - if(internal%ens_id ==0 ) ppert_enavg(:,:,:)=0. ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next + if(internal%ens_id == FIRST_ENS_ID) ppert_enavg(:,:,:)=0. ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next do m = 1,internal%PrognPert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), ppert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%PrognPert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then ppert_enavg(:,:,m)=ppert_enavg(:,:,m)+ppert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id == internal%NUM_ENSEMBLE -1) then ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next + if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE -1) then ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next ppert_enavg(:,:,m) = -ppert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1712,7 +1712,7 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) endif ! Update the r4 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_KIND_R8) - pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? + pert_iseed(:,internal%ens_id+1 - FIRST_ENS_ID) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? call MAPL_TimerOff(MAPL, "GenerateRaw") ! End @@ -2170,7 +2170,7 @@ subroutine ApplyForcePert(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed if (internal%PERTURBATIONS /=0 ) then pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? + pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? endif ! Clean up @@ -2561,7 +2561,7 @@ subroutine ApplyPrognPert(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? + pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? ! Clean up if (allocated(PROGNPERT)) then @@ -2633,7 +2633,7 @@ subroutine Update_pert_rseed(gc,import,export,clock,rc) VERIFY_(status) endif - pert_rseed_r8(:) = real(pert_iseed(:,internal%ens_id+1),kind=ESMF_KIND_R8) ! reichle, 18 May 2020: "%ens_counter" ?? + pert_rseed_r8(:) = real(pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID),kind=ESMF_KIND_R8) ! reichle, 18 May 2020: "%ens_counter" ?? ! End RETURN_(ESMF_SUCCESS) From 4aca8c9fd2d6e4888010185ebec78b1b43bacea7 Mon Sep 17 00:00:00 2001 From: Rolf Reichle Date: Tue, 19 May 2020 10:48:20 -0400 Subject: [PATCH 18/19] cleanup of comments and obsolete subroutines --- .../GEOS_LandAssimGridComp.F90 | 6 +- .../GEOS_LandPertGridComp.F90 | 22 +- .../LDAS_PertRoutines.F90 | 319 ------------------ .../GEOSlandpert_GridComp/land_pert.F90 | 4 +- 4 files changed, 17 insertions(+), 334 deletions(-) diff --git a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 index 6d5e8db8..4d6347f7 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandassim_GridComp/GEOS_LandAssimGridComp.F90 @@ -101,9 +101,9 @@ module GEOS_LandAssimGridCompMod integer, dimension(:), pointer :: l2rf, rf2l,rf2g, rf2f type(tile_coord_type), dimension(:), pointer :: tile_coord_rf => null() - integer, allocatable :: Pert_rseed(:,:) + integer, allocatable :: Pert_rseed( :,:) real(kind=ESMF_KIND_R8), allocatable :: pert_rseed_r8(:,:) - type(mwRTM_param_type), dimension(:), allocatable :: mwRTM_param + type(mwRTM_param_type), dimension(:), allocatable :: mwRTM_param logical :: mwRTM_all_nodata ! no data for mwRTM_param logical :: land_assim @@ -1059,7 +1059,7 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_LocStreamGet(locstream, NT_LOCAL=land_nt_local,rc=status) _VERIFY(status) - allocate(Pert_rseed(NRANDSEED, NUM_ENSEMBLE), source = 0) + allocate(Pert_rseed( NRANDSEED, NUM_ENSEMBLE), source = 0 ) allocate(Pert_rseed_r8(NRANDSEED, NUM_ENSEMBLE), source = 0.0d0) if (master_proc) then diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 index f51b903f..7c298c07 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/GEOS_LandPertGridComp.F90 @@ -1646,7 +1646,7 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) call MAPL_DateStampGet(clock, datestamp, rc=status) VERIFY_(STATUS) - write(id_string,'(I4.4)') internal%ens_id ! reichle, 18 May 2020: ens_id vs. ens_counter ?? + write(id_string,'(I4.4)') internal%ens_id if(internal%NUM_ENSEMBLE ==1 ) id_string='' chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint.'//datestamp @@ -1665,17 +1665,17 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) real(internal%ForcePert%dtstep), & pert_rseed, & internal%ForcePert%param, & - fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert), & + fpert_ntrmdt(lon1:lon2,lat1:lat2,1:internal%ForcePert%npert), & .false. & ) - if(internal%ens_id == FIRST_ENS_ID ) fpert_enavg(:,:,:)=0. ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next + if(internal%ens_id == FIRST_ENS_ID ) fpert_enavg(:,:,:)=0. do m = 1,internal%ForcePert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), fpert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%ForcePert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then fpert_enavg(:,:,m)=fpert_enavg(:,:,m)+fpert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE-1) then ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next + if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE-1) then fpert_enavg(:,:,m) = -fpert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1696,13 +1696,13 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) .false. & ) - if(internal%ens_id == FIRST_ENS_ID) ppert_enavg(:,:,:)=0. ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next + if(internal%ens_id == FIRST_ENS_ID) ppert_enavg(:,:,:)=0. do m = 1,internal%PrognPert%npert call tile_mask_grid(internal%pgrid_l, land_nt_local, internal%i_indgs(:),internal%j_indgs(:), ppert_ntrmdt(lon1:lon2,lat1:lat2,m)) if(internal%PrognPert%param(m)%zeromean .and. internal%NUM_ENSEMBLE >2) then ppert_enavg(:,:,m)=ppert_enavg(:,:,m)+ppert_ntrmdt(lon1:lon2,lat1:lat2,m) - if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE -1) then ! reichle, 18 May 2020: see comments ~Line 1160 re. this block and next + if( internal%ens_id - FIRST_ENS_ID == internal%NUM_ENSEMBLE -1) then ppert_enavg(:,:,m) = -ppert_enavg(:,:,m)/real(internal%NUM_ENSEMBLE) endif endif @@ -1712,7 +1712,7 @@ subroutine GenerateRaw_ntrmdt(gc, import, export, clock, rc) endif ! Update the r4 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_KIND_R8) - pert_iseed(:,internal%ens_id+1 - FIRST_ENS_ID) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? + pert_iseed(:,internal%ens_id+1 - FIRST_ENS_ID) = pert_rseed call MAPL_TimerOff(MAPL, "GenerateRaw") ! End @@ -2170,7 +2170,7 @@ subroutine ApplyForcePert(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed if (internal%PERTURBATIONS /=0 ) then pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? + pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed endif ! Clean up @@ -2561,7 +2561,7 @@ subroutine ApplyPrognPert(gc, import, export, clock, rc) ! Update the r8 version of pert_rseed pert_rseed_r8 = real(pert_rseed,kind=ESMF_kind_r8) - pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed ! reichle, 18 May 2020: "%ens_counter" ?? + pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID) = pert_rseed ! Clean up if (allocated(PROGNPERT)) then @@ -2633,7 +2633,7 @@ subroutine Update_pert_rseed(gc,import,export,clock,rc) VERIFY_(status) endif - pert_rseed_r8(:) = real(pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID),kind=ESMF_KIND_R8) ! reichle, 18 May 2020: "%ens_counter" ?? + pert_rseed_r8(:) = real(pert_iseed(:,internal%ens_id+1-FIRST_ENS_ID),kind=ESMF_KIND_R8) ! End RETURN_(ESMF_SUCCESS) @@ -2759,7 +2759,7 @@ subroutine Finalize(gc, import, export, clock, rc) enddo ! 4) writing - write(id_string,'(I4.4)') internal%ens_id ! reichle, 18 May 2020: ens_id vs. ens_counter ?? + write(id_string,'(I4.4)') internal%ens_id if(internal%NUM_ENSEMBLE ==1 ) id_string='' chk_fname = 'landpert'//trim(id_string)//'_internal_checkpoint' diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 index 57907ad3..04ab04ea 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/LDAS_PertRoutines.F90 @@ -1936,137 +1936,6 @@ end subroutine get_pert_select ! ********************************************************************* - ! subroutine get_tile_pert( & - ! N_pert, N_ens, pert_grid_f, pert_grid_l, & - ! dtstep, & - ! N_catl, tile_coord_l, & - ! pert_param, & - ! Pert_rseed, Pert_ntrmdt, & - ! Pert_tile, & - ! ens_id, & - ! initialize_rseed, & - ! initialize_ntrmdt, & - ! diagnose_pert_only ) - - ! ! get perturbations in tile space - - ! implicit none - - ! integer, intent(in) :: N_pert, N_ens - - ! type(grid_def_type), intent(in) :: pert_grid_f, pert_grid_l - - ! real, intent(in) :: dtstep - - ! integer, intent(in) :: N_catl - - ! type(tile_coord_type), dimension(:), pointer :: tile_coord_l - - ! type(pert_param_type), dimension(:), pointer :: pert_param - - ! integer, dimension(NRANDSEED,N_ens), intent(inout) :: Pert_rseed - - ! real, dimension(N_pert,pert_grid_l%N_lon,pert_grid_l%N_lat,N_ens), & - ! intent(inout) :: Pert_ntrmdt - - ! real, dimension(N_pert, N_catl, N_ens), intent(out) :: Pert_tile - - ! integer, dimension(N_ens), intent(in), optional :: ens_id - - ! logical, intent(in), optional :: initialize_rseed - ! logical, intent(in), optional :: initialize_ntrmdt - - ! logical, intent(in), optional :: diagnose_pert_only - - ! ! local variables - - ! integer :: i, n_e - - ! real, dimension(N_pert,pert_grid_l%N_lon,pert_grid_l%N_lat,N_ens) :: & - ! Pert_grid - - ! real, dimension(pert_grid_l%N_lon,pert_grid_l%N_lat) :: grid_data - ! real, dimension(N_catl) :: tile_data - - ! logical :: init_rseed, init_ntrmdt, diagn_only - - ! character(len=400) :: err_msg - ! character(len=*), parameter :: Iam = 'get_tile_pert' - - ! ! ------------------------------------------------------------ - - ! init_rseed = .false. - ! init_ntrmdt = .false. - - ! if (present(initialize_rseed)) init_rseed = initialize_rseed - ! if (present(initialize_ntrmdt)) init_ntrmdt = initialize_ntrmdt - - ! if (init_rseed) then - - ! write (logunit,*) 'initializing random seed from scratch' - - ! if (present(ens_id)) then - - ! call get_init_Pert_rseed( N_ens, ens_id, Pert_rseed(1,:) ) - - ! else - - ! call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'ens_id not present') - - ! end if - - ! end if - - ! ! ----------------------------------------------------------------- - - ! diagn_only = .false. - - ! if (present(diagnose_pert_only)) diagn_only = diagnose_pert_only - - ! if ( diagn_only .and. (init_rseed .or. init_ntrmdt) ) then - - ! call ldas_abort(LDAS_GENERIC_ERROR, Iam, 'contradictory optional inputs') - - ! end if - - ! ! ----------------------------------------------------------------- - - ! call get_pert( & - ! N_pert, N_ens, & - ! pert_grid_f, pert_grid_l, & - ! dtstep, & - ! pert_param, & - ! Pert_rseed, & - ! Pert_ntrmdt, & - ! Pert_grid, & - ! initialize_rseed=init_rseed, & - ! initialize_ntrmdt=init_ntrmdt, & - ! diagnose_pert_only=diagn_only ) - - ! ! ----------------------------------------------------------------- - - ! ! map to tile space - - ! do i=1,N_pert - ! do n_e=1,N_ens - - ! grid_data = Pert_grid(i,:,:,n_e) - - ! ! this call to grid2tile() links the grid on which perturbations - ! ! are computed to the GEOS5 tile_grid - - ! call grid2tile( pert_grid_l, N_catl, tile_coord_l, grid_data, & - ! tile_data) - - ! Pert_tile(i,:,n_e) = tile_data - - ! end do - ! end do - - ! end subroutine get_tile_pert - - ! ********************************************************************* - subroutine interpolate_pert_to_timestep( & date_time, pert_time_old, pert_dtstep_real, & Pert_old, Pert_new, Pert_ntp ) @@ -2361,194 +2230,6 @@ subroutine io_pert_rstrt( action, work_path, exp_id, ens_id, & end subroutine io_pert_rstrt -! subroutine initialize_perturbations( & -! N_catl, N_ens, ens_id, start_time, & -! restart_path, restart_domain, restart_id, work_path, exp_id, & -! tile_coord_l, pert_grid_f, pert_grid_l, & -! N_force_pert, N_progn_pert, & -! force_pert_param, progn_pert_param, & -! Pert_rseed, Force_pert_ntrmdt_l, Progn_pert_ntrmdt_l, & -! Force_pert_tile_new, Force_pert_tile_old, & -! Progn_pert_tile_new, Progn_pert_tile_old ) - -! ! Initialize perturbations variables either from a restart file or -! ! by reinitializing the seed -! ! -! ! reichle, 21 Jun 2005 -! ! reichle, 16 Oct 2008 - eliminated logical variable "restart_pert" from input list -! ! -! ! ----------------------------------------------------------------- - -! implicit none - -! integer, intent(in) :: N_catl, N_ens - -! integer, intent(in), dimension(N_ens) :: ens_id - -! type(date_time_type), intent(in) :: start_time - -! character(200), intent(in) :: restart_path, work_path - -! character(40), intent(in) :: restart_domain, restart_id, exp_id - -! type(tile_coord_type), dimension(:), pointer :: tile_coord_l ! input - -! type(grid_def_type), intent(in) :: pert_grid_f, pert_grid_l - -! integer, intent(in) :: N_force_pert, N_progn_pert - -! type(pert_param_type), dimension(:), pointer :: force_pert_param ! input -! type(pert_param_type), dimension(:), pointer :: progn_pert_param ! input - -! integer, dimension(NRANDSEED,N_ens), intent(out) :: Pert_rseed - -! real, dimension(N_force_pert,pert_grid_l%N_lon,pert_grid_l%N_lat,N_ens), & -! intent(out) :: Force_pert_ntrmdt_l - -! real, dimension(N_progn_pert,pert_grid_l%N_lon,pert_grid_l%N_lat,N_ens), & -! intent(out) :: Progn_pert_ntrmdt_l - -! real, dimension(N_force_pert,N_catl,N_ens), intent(out) :: & -! Force_pert_tile_new, Force_pert_tile_old - -! real, dimension(N_progn_pert,N_catl,N_ens), intent(out) :: & -! Progn_pert_tile_new, Progn_pert_tile_old - -! character(len=*), parameter :: Iam = 'initialize_perturbations' -! character(len=400) :: err_msg - -! ! --------------------------------- - -! ! locals - -! character(200) :: restart_path_tmp - -! integer :: n_e, rc - -! logical :: initialize_rseed, initialize_ntrmdt, diagnose_pert_only, restart_pert - -! ! ----------------------------------------------------------------------- - -! write (logunit,*) - -! ! CHANGED: Replaced call to add_domain_to_path by its content -! ! restart_path_tmp = add_domain_to_path( restart_path, restart_domain ) -! restart_path_tmp = trim(restart_path) // '/' // trim(restart_domain) // '/' - -! initialize_rseed = .true. -! initialize_ntrmdt = .true. - -! diagnose_pert_only = .false. - -! restart_pert = .false. ! assume restart file is NOT available - -! ! try getting perturbations prognostics from restart file - -! do n_e=1,N_ens - -! call io_pert_rstrt( 'r', restart_path_tmp, restart_id, ens_id(n_e), & -! start_time, tile_coord_l, pert_grid_l, pert_grid_f, & -! N_force_pert, N_progn_pert, Pert_rseed(:,n_e), & -! Force_pert_ntrmdt_l(:,:,:,n_e), Progn_pert_ntrmdt_l(:,:,:,n_e), rc ) - -! if (n_e==1) then - -! ! set restart_pert to true if first pert restart file was successfully read - -! if (rc==0) restart_pert = .true. - -! else - -! ! stop if restart file was read for first but not for current ensemble member - -! if (rc/=0 .and. restart_pert) then -! err_msg = 'found pert restart file for some but not all ens members' -! call ldas_abort(LDAS_GENERIC_ERROR, Iam, err_msg) -! end if - -! end if - -! end do - -! ! broadcast Pert_rseed -! call MPI_Bcast(Pert_rseed,NRANDSEED*N_ens,MPI_INTEGER,0,mpicomm,mpierr) - -! ! restart_pert is now true if pert restart files were available for all ens members, -! ! false otherwise - -! if (restart_pert) then - -! initialize_rseed = .false. -! initialize_ntrmdt = .false. - -! diagnose_pert_only = .true. - -! end if - -! ! -------------------------------------------------------------------- -! ! -! ! get perturbations prognostics (unless read from restart file) and -! ! perturbations diagnostics - -! if (N_force_pert>0) then - -! call get_tile_pert( & -! N_force_pert, N_ens, pert_grid_f, pert_grid_l, & -! nodata_generic, & -! N_catl, tile_coord_l, & -! force_pert_param, & -! Pert_rseed, & -! Force_pert_ntrmdt_l, & -! Force_pert_tile_old, & -! ens_id=ens_id, & -! initialize_rseed=initialize_rseed, & -! initialize_ntrmdt=initialize_ntrmdt, & -! diagnose_pert_only=diagnose_pert_only ) - -! Force_pert_tile_new = Force_pert_tile_old - -! initialize_rseed = .false. - -! end if - -! if (N_progn_pert>0) then - -! call get_tile_pert( & -! N_progn_pert, N_ens, pert_grid_f, pert_grid_l, & -! nodata_generic, & -! N_catl, tile_coord_l, & -! progn_pert_param, & -! Pert_rseed, & -! Progn_pert_ntrmdt_l, & -! Progn_pert_tile_old, & -! ens_id=ens_id, & -! initialize_rseed=initialize_rseed, & -! initialize_ntrmdt=initialize_ntrmdt, & -! diagnose_pert_only=diagnose_pert_only ) - -! Progn_pert_tile_new = Progn_pert_tile_old - -! end if - -! ! -------------------------------------------------------------------- -! ! -! ! if no restart file was available or restart file was from a -! ! different experiment, write out initial restart file -! ! for current experiment - -! if ( (.not. restart_pert) .or. (trim(restart_path_tmp)/=trim(work_path)) ) then - -! do n_e=1,N_ens -! call io_pert_rstrt( 'w', work_path, exp_id, ens_id(n_e), & -! start_time, tile_coord_l, pert_grid_l, pert_grid_f, & -! N_force_pert, N_progn_pert, Pert_rseed(:,n_e), & -! Force_pert_ntrmdt_l(:,:,:,n_e), Progn_pert_ntrmdt_l(:,:,:,n_e) ) -! end do - -! end if - -! end subroutine initialize_perturbations - ! ****************************************************************** ! handle return code of nf90_* calls diff --git a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 index 2246f1c4..6082d52d 100644 --- a/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 +++ b/src/Components/GEOSldas_GridComp/GEOSlandpert_GridComp/land_pert.F90 @@ -312,7 +312,9 @@ subroutine GEOSldas_get_pert( & end subroutine GEOSldas_get_pert - subroutine LDASsa_get_pert( & + ! ****************************************************************** + + subroutine LDASsa_get_pert( & N_pert, N_ens, & pert_grid_f, pert_grid_l, & dtstep, & From 9860e9e1dbe27b41486360aa03d9bd469f70815d Mon Sep 17 00:00:00 2001 From: Rolf Reichle <54944691+gmao-rreichle@users.noreply.github.com> Date: Tue, 19 May 2020 11:46:01 -0400 Subject: [PATCH 19/19] removing check for RST_FROM_GLOBAL --- src/Applications/LDAS_App/ldas_setup | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Applications/LDAS_App/ldas_setup b/src/Applications/LDAS_App/ldas_setup index 6865dd99..8db842a0 100755 --- a/src/Applications/LDAS_App/ldas_setup +++ b/src/Applications/LDAS_App/ldas_setup @@ -355,8 +355,6 @@ class LDASsetup: # DEAL WITH mwRTM input from exec self.assim = True if self.rqdExeInp.get('LAND_ASSIM', 'NO').upper() == 'YES' else False - if (self.assim) : - assert int(self.rqdExeInp['RST_FROM_GLOBAL']) == 1, 'So far, only global datat assimilation is supported' # verify mwrtm file if 'MWRTM_FILE' in self.rqdExeInp : _tmpfile = self.rqdExeInp['MWRTM_FILE'].replace("'",'').replace('"','')