diff --git a/GEOS_LdasGridComp.F90 b/GEOS_LdasGridComp.F90 index bff5883..815dc37 100644 --- a/GEOS_LdasGridComp.F90 +++ b/GEOS_LdasGridComp.F90 @@ -61,7 +61,7 @@ module GEOS_LdasGridCompMod logical :: land_assim logical :: mwRTM logical :: ensemble_forcing ! switch between deterministic and ensemble forcing - + logical :: with_landice contains !BOP @@ -87,7 +87,7 @@ subroutine SetServices(gc, rc) character(len=ESMF_MAXSTR) :: Iam character(len=ESMF_MAXSTR) :: comp_name character(len=ESMF_MAXSTR) :: ensid_string,childname - character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR + character(len=ESMF_MAXSTR) :: LAND_ASSIM_STR, mwRTM_file, ENS_FORCING_STR, WITH_LANDICE_STR integer :: ens_id_width ! Local variables type(T_TILECOORD_STATE), pointer :: tcinternal @@ -96,7 +96,7 @@ subroutine SetServices(gc, rc) type(ESMF_Config) :: CF integer :: LSM_CHOICE integer :: FIRST_ENS_ID - + ! Begin... ! Get my name and setup traceback handle @@ -158,6 +158,12 @@ subroutine SetServices(gc, rc) VERIFY_(STATUS) land_assim = (trim(LAND_ASSIM_STR) /= 'NO') + call MAPL_GetResource ( MAPL, WITH_LANDICE_STR, Label="WITH_LANDICE:", DEFAULT="NO", RC=STATUS) + VERIFY_(STATUS) + WITH_LANDICE_STR = ESMF_UtilStringUpperCase(WITH_LANDICE_STR, rc=STATUS) + VERIFY_(STATUS) + with_landice = (trim(WITH_LANDICE_STR) /= 'NO') + call MAPL_GetResource ( MAPL, mwRTM_file, Label="LANDASSIM_INTERNAL_RESTART_FILE:", DEFAULT='', RC=STATUS) VERIFY_(STATUS) mwRTM = ( len_trim(mwRTM_file) /= 0 ) @@ -174,7 +180,7 @@ subroutine SetServices(gc, rc) endif allocate(LAND(NUM_ENSEMBLE),LANDPERT(NUM_ENSEMBLE)) - allocate(LANDICE(NUM_ENSEMBLE)) + if (with_landice) allocate(LANDICE(NUM_ENSEMBLE)) ! ens_id_with = 2 + number of digits = total number of chars in ensid_string ("_eXXXX") ! @@ -216,9 +222,11 @@ subroutine SetServices(gc, rc) LAND(i) = MAPL_AddChild(gc, name=childname, ss=LandSetServices, rc=status) VERIFY_(status) - childname='LANDICE'//trim(ensid_string) - LANDICE(i) = MAPL_AddChild(gc, name=childname, ss=LandiceSetServices, rc=status) - VERIFY_(status) + if (with_landice) then + childname='LANDICE'//trim(ensid_string) + LANDICE(i) = MAPL_AddChild(gc, name=childname, ss=LandiceSetServices, rc=status) + VERIFY_(status) + endif enddo ENSAVG = MAPL_AddChild(gc, name='ENSAVG', ss=EnsSetServices, rc=status) @@ -231,19 +239,8 @@ subroutine SetServices(gc, rc) ! Connections do i=1,NUM_ENSEMBLE - ! -METFORCE-feeds-LANDPERT's-imports- k = 1 if ( ensemble_forcing ) k = i - call MAPL_AddConnectivity( & - gc, & - SHORT_NAME = ['Tair ', 'Qair ', 'Psurf ', 'Rainf_C', 'Rainf ', & - 'Snowf ', 'LWdown ', 'SWdown ', 'PARdrct', 'PARdffs', & - 'Wind ', 'RefH '], & - SRC_ID = METFORCE(k), & - DST_ID = LANDPERT(i), & - rc = status & - ) - VERIFY_(status) ! -LANDPERT-feeds-LAND's-imports- call MAPL_AddConnectivity( & gc, & @@ -262,57 +259,6 @@ subroutine SetServices(gc, rc) ) VERIFY_(status) - ! -LANDPERT-feeds-LANDICE's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['TApert ', 'QApert ', 'UUpert ', & - 'UWINDLMTILEpert', 'VWINDLMTILEpert', 'PCUpert ', & - 'PLSpert ', 'SNOpert ', 'DRPARpert ', & - 'DFPARpert ', 'DRNIRpert ', 'DFNIRpert ', & - 'DRUVRpert ', 'DFUVRpert ', 'LWDNSRFpert '], & - SRC_ID = LANDPERT(i), & - DST_NAME = ['TA ', 'QA ', 'UU ', 'UWINDLMTILE',& - 'VWINDLMTILE', 'PCU ', 'PLS ', 'SNO ',& - 'DRPAR ', 'DFPAR ', 'DRNIR ', 'DFNIR ',& - 'DRUVR ', 'DFUVR ', 'LWDNSRF '], & - DST_ID = LANDICE(i), & - rc = status & - ) - - ! -METFORCE-feeds-LAND's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['Psurf', 'RefH ', & - 'DUDP ', 'DUSV ', 'DUWT ', 'DUSD ', 'BCDP ', 'BCSV ', & - 'BCWT ', 'BCSD ', 'OCDP ', 'OCSV ', 'OCWT ', 'OCSD ', & - 'SUDP ', 'SUSV ', 'SUWT ', 'SUSD ', 'SSDP ', 'SSSV ' ], & - SRC_ID = METFORCE(k), & - DST_NAME = ['PS ', 'DZ ', & - 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & - 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & - 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ], & - DST_ID = LAND(i), & - rc = status & - ) - VERIFY_(status) - - ! -METFORCE-feeds-LANDICE's-imports- - call MAPL_AddConnectivity( & - gc, & - SRC_NAME = ['Psurf', 'RefH ', & - 'DUDP ', 'DUSV ', 'DUWT ', 'DUSD ', 'BCDP ', 'BCSV ', & - 'BCWT ', 'BCSD ', 'OCDP ', 'OCSV ', 'OCWT ', 'OCSD ', & - 'SUDP ', 'SUSV ', 'SUWT ', 'SUSD ', 'SSDP ', 'SSSV ' ], & - SRC_ID = METFORCE(k), & - DST_NAME = ['PS ', 'DZ ', & - 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & - 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & - 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ], & - DST_ID = LANDICE(i), & - rc = status & - ) - VERIFY_(status) - ! -LAND-feeds-LANDPERT's-imports- call MAPL_AddConnectivity( & gc, & @@ -411,6 +357,7 @@ subroutine Initialize(gc, import, export, clock, rc) type(MAPL_LocStream) :: surf_locstream type(MAPL_LocStream) :: land_locstream type(MAPL_LocStream) :: landice_locstream + type(MAPL_LocStream) :: force_locstream type(MAPL_MetaComp), pointer :: MAPL=>null() ! GC's MAPL obj type(MAPL_MetaComp), pointer :: CHILD_MAPL=>null() ! Child's MAPL obj @@ -426,7 +373,7 @@ subroutine Initialize(gc, import, export, clock, rc) character(len=ESMF_MAXSTR) :: LAND_PARAMS character(len=ESMF_MAXSTR) :: grid_type - integer :: total_nt,land_nt_local,i,j + integer :: total_nt, land_nt_local, i, j real, pointer :: LandTileLats(:) real, pointer :: LandTileLons(:) integer, pointer :: local_id(:) @@ -614,15 +561,25 @@ subroutine Initialize(gc, import, export, clock, rc) ) VERIFY_(status) - call MAPL_LocStreamCreate( & - landice_locstream, & - surf_locstream, & - name=gcnames(LANDICE(1)), & - mask=[MAPL_LANDICE], & - rc=status & + if (with_landice) then + call MAPL_LocStreamCreate( & + force_locstream, & + surf_locstream, & + name=gcnames(METFORCE(1)), & + mask=[MAPL_LAND, MAPL_LANDICE], & + rc=status & ) - VERIFY_(status) + VERIFY_(status) + call MAPL_LocStreamCreate( & + landice_locstream, & + surf_locstream, & + name=gcnames(LANDICE(1)), & + mask=[MAPL_LANDICE], & + rc=status & + ) + VERIFY_(status) + endif call MAPL_TimerOff(MAPL, "-LocStreamCreate") ! Convert LAND's LocStream to LDAS' tile_coord and save it in the GridComp @@ -760,10 +717,14 @@ subroutine Initialize(gc, import, export, clock, rc) do i = 1, NUM_ENSEMBLE call MAPL_GetObjectFromGC(gcs(METFORCE(i)), CHILD_MAPL, rc=status) VERIFY_(status) ! CHILD = METFORCE - call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) - VERIFY_(status) - call ESMF_UserCompSetInternalState(gcs(METFORCE(i)), 'TILE_COORD', tcwrap, status) - VERIFY_(status) + if ( with_landice) then + call MAPL_Set(CHILD_MAPL, LocStream=force_locstream, rc=status) + VERIFY_(status) + else + call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) + VERIFY_(status) + endif + ! exit after i=1 if using deterministic forcing if (.not. ensemble_forcing) exit enddo @@ -779,10 +740,12 @@ subroutine Initialize(gc, import, export, clock, rc) call MAPL_Set(CHILD_MAPL, LocStream=land_locstream, rc=status) VERIFY_(status) - call MAPL_GetObjectFromGC(gcs(LANDICE(i)), CHILD_MAPL, rc=status) - VERIFY_(status) - call MAPL_Set(CHILD_MAPL, LocStream=landice_locstream, rc=status) - VERIFY_(status) + if (with_landice) then + call MAPL_GetObjectFromGC(gcs(LANDICE(i)), CHILD_MAPL, rc=status) + VERIFY_(status) + call MAPL_Set(CHILD_MAPL, LocStream=landice_locstream, rc=status) + VERIFY_(status) + endif call MAPL_GetObjectFromGC(gcs(LANDPERT(i)), CHILD_MAPL, rc=status) VERIFY_(status) ! CHILD = LANDPERT @@ -792,8 +755,6 @@ subroutine Initialize(gc, import, export, clock, rc) ! Add LAND's tile_coord to children's GridComps call ESMF_UserCompSetInternalState(gcs(LAND(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) - call ESMF_UserCompSetInternalState(gcs(LANDICE(i)), 'TILE_COORD', tcwrap, status) - VERIFY_(status) call ESMF_UserCompSetInternalState(gcs(LANDPERT(i)), 'TILE_COORD', tcwrap, status) VERIFY_(status) enddo @@ -886,7 +847,7 @@ subroutine Run(gc, import, export, clock, rc) type(MAPL_MetaComp), pointer :: MAPL ! Misc variables - integer :: igc,i, ens_id, FIRST_ENS_ID, ens_id_width + integer :: igc, i, ens_id, FIRST_ENS_ID, ens_id_width, k logical :: IAmRoot integer :: LSM_CHOICE type (ESMF_Field) :: field @@ -957,13 +918,30 @@ subroutine Run(gc, import, export, clock, rc) do i = 1, NUM_ENSEMBLE igc = METFORCE(i) call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, userRC=status) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) ! exit after i=1 if using deterministic forcing if (.not. ensemble_forcing) exit enddo + ! distribute force. ( export of focrce to the import of land, landpert and landice) + do i = 1, NUM_ENSEMBLE + k = 1 + if (ensemble_forcing) k = i + igc = METFORCE(k) + call MAPL_TimerOn(MAPL, gcnames(igc)) + + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LAND(i)), clock=clock, phase=2, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDPERT(i)), clock=clock, phase=3, userRC=status) + VERIFY_(status) + if (with_landice) then + call ESMF_GridCompRun(gcs(igc), importState=gex(igc), exportState=gim(LANDICE(i)), clock=clock, phase=4, userRC=status) + VERIFY_(status) + endif + call MAPL_TimerOff(MAPL, gcnames(igc)) + enddo do i = 1,NUM_ENSEMBLE @@ -991,15 +969,15 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_TimerOff(MAPL, gcnames(igc)) - - igc = LANDICE(i) - call MAPL_TimerOn(MAPL, gcnames(igc)) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) - VERIFY_(status) - call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) - VERIFY_(status) - call MAPL_TimerOff(MAPL, gcnames(igc)) - + if (with_landice) then + igc = LANDICE(i) + call MAPL_TimerOn(MAPL, gcnames(igc)) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=1, userRC=status) + VERIFY_(status) + call ESMF_GridCompRun(gcs(igc), importState=gim(igc), exportState=gex(igc), clock=clock, phase=2, userRC=status) + VERIFY_(status) + call MAPL_TimerOff(MAPL, gcnames(igc)) + endif ! ApplyPrognPert - moved: now before calculating ensemble average that is picked up by land analysis and HISTORY; reichle 28 May 2020 igc = LANDPERT(i) diff --git a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 index 8b87cbb..2fb7ac7 100644 --- a/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 +++ b/GEOSmetforce_GridComp/GEOS_MetforceGridComp.F90 @@ -59,6 +59,7 @@ module GEOS_MetforceGridCompMod ! Met forcing data type(met_force_type), pointer, contiguous :: DataPrv(:) type(met_force_type), pointer, contiguous :: DataNxt(:) + type(tile_coord_type),pointer, contiguous :: tile_coord(:) end type T_MET_FORCING ! Internal state and its wrapper @@ -70,7 +71,24 @@ module GEOS_MetforceGridCompMod type(T_METFORCE_STATE), pointer :: ptr=>null() end type METFORCE_WRAP -contains + integer, parameter :: k_force = 12 + integer, parameter :: k_aerosol = 18 + integer, parameter :: k_landice = 15 + character(len=7), dimension(k_force) :: export_name = ['Tair ', 'Qair ', 'Psurf ', & + 'Rainf_C', 'Snowf ', 'LWdown ', & + 'PARdrct', 'PARdffs', 'Wind ', & + 'RefH ', 'Rainf ', 'SWdown '] + character(len=4), dimension(k_aerosol) :: aerosol_name = [ & + 'DUDP', 'DUSV', 'DUWT', 'DUSD', 'BCDP', 'BCSV', & + 'BCWT', 'BCSD', 'OCDP', 'OCSV', 'OCWT', 'OCSD', & + 'SUDP', 'SUSV', 'SUWT', 'SUSD', 'SSDP', 'SSSV' ] + character(len=11), dimension(k_landice) :: landice_name = ['TA ', 'QA ', 'PS ', & + 'PCU ', 'SNO ', 'LWDNSRF ', & + 'DRPAR ', 'DFPAR ', 'UU ', & + 'DZ ', 'DRNIR ', 'DFNIR ', & + 'DRUVR ', 'DFUVR ', 'PLS '] + integer :: NUM_LAND_TILE, NUM_LANDICE_TILE + contains !BOP @@ -115,6 +133,8 @@ subroutine SetServices(gc, rc) rc=status & ) VERIFY_(status) + + ! phase 1 get force call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_RUN, & @@ -122,6 +142,33 @@ subroutine SetServices(gc, rc) rc=status & ) VERIFY_(status) + ! phase 2: to land + call MAPL_GridCompSetEntryPoint( & + gc, & + ESMF_METHOD_RUN, & + DistributeForcetoLand, & + rc=status & + ) + VERIFY_(status) + + ! phase 3: to landpert + call MAPL_GridCompSetEntryPoint( & + gc, & + ESMF_METHOD_RUN, & + DistributeForcetoLandPert, & + rc=status & + ) + VERIFY_(status) + + ! phase 4: to landice + call MAPL_GridCompSetEntryPoint( & + gc, & + ESMF_METHOD_RUN, & + DistributeForcetoLandIce, & + rc=status & + ) + VERIFY_(status) + call MAPL_GridCompSetEntryPoint( & gc, & ESMF_METHOD_FINALIZE, & @@ -555,15 +602,19 @@ subroutine Initialize(gc, import, export, clock, rc) ! Internal private state variables type(T_METFORCE_STATE), pointer :: internal=>null() type(METFORCE_WRAP) :: wrap - type(TILECOORD_WRAP) :: tcwrap type(tile_coord_type), pointer :: tile_coord(:)=>null() ! Misc variables - integer :: land_nt_local, k, NUM_ENSEMBLE + integer :: nt_local, k, NUM_ENSEMBLE integer :: ForceDtStep type(met_force_type) :: mf_nodata logical :: MERRA_file_specs, ensemble_forcing logical :: backward_looking_fluxes + real, pointer :: TileLats(:) + real, pointer :: TileLons(:) + integer, pointer :: i_indg(:) + integer, pointer :: j_indg(:) + integer, pointer :: tiletype(:) integer :: AEROSOL_DEPOSITION type(MAPL_LocStream) :: locstream @@ -596,21 +647,30 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) internal => wrap%ptr - ! Get component's internal tile_coord variable - call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) - VERIFY_(status) - tile_coord => tcwrap%ptr%tile_coord - - ! Number of land tiles (on local PE) call MAPL_Get(MAPL, LocStream=locstream) VERIFY_(status) call MAPL_LocStreamGet( & locstream, & - NT_LOCAL=land_nt_local, & + NT_LOCAL=nt_local, & + TILELATS=TileLats, & + TILELONS=TileLons, & + LOCAL_I =i_indg, & + LOCAL_J =j_indg, & + TILETYPE=tiletype, & rc=status & ) VERIFY_(status) + NUM_LAND_TILE = count(tiletype == MAPL_LAND) + NUM_LANDICE_TILE = count(tiletype == MAPL_LANDICE) + + + allocate(mf%tile_coord(nt_local)) + mf%tile_coord(:)%com_lon = TileLons + mf%tile_coord(:)%com_lat = TileLats + mf%tile_coord(:)%i_indg = i_indg + mf%tile_coord(:)%j_indg = j_indg + call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & DEFAULT=0, RC=STATUS) @@ -663,12 +723,12 @@ subroutine Initialize(gc, import, export, clock, rc) VERIFY_(status) ! -allocate-memory-for-metforcing-data- mf_nodata = nodata_generic - allocate(mf%DataPrv(land_nt_local), source=mf_nodata, stat=status) + allocate(mf%DataPrv(nt_local), source=mf_nodata, stat=status) VERIFY_(status) - allocate(mf%DataNxt(land_nt_local), source=mf_nodata, stat=status) + allocate(mf%DataNxt(nt_local), source=mf_nodata, stat=status) VERIFY_(status) ! -allocate-memory-for-avg-zenith-angle - allocate(mf%zenav(land_nt_local), source=nodata_generic, stat=status) + allocate(mf%zenav(nt_local), source=nodata_generic, stat=status) VERIFY_(status) call MAPL_GetResource ( MAPL, ENS_FORCING_STR, Label="ENSEMBLE_FORCING:", DEFAULT="NO", RC=STATUS) VERIFY_(STATUS) @@ -686,6 +746,7 @@ subroutine Initialize(gc, import, export, clock, rc) endif ! Put MetForcing in Ldas' pvt internal state internal%mf = mf + tile_coord => internal%mf%tile_coord ! Create alarm for MetForcing ! -create-nonsticky-alarm- MetForcingAlarm = ESMF_AlarmCreate( & @@ -710,7 +771,7 @@ subroutine Initialize(gc, import, export, clock, rc) ForceDtStep, & internal%mf%Path, & internal%mf%Tag, & - land_nt_local, & + nt_local, & tile_coord, & internal%mf%hinterp, & AEROSOL_DEPOSITION, & @@ -783,21 +844,18 @@ subroutine Run(gc, import, export, clock, rc) ! Private internal state variables type(T_METFORCE_STATE), pointer :: internal=>null() type(METFORCE_WRAP) :: wrap - type(TILECOORD_WRAP) :: tcwrap ! LDAS' tile_coord variable type(tile_coord_type), pointer :: tile_coord(:) ! Misc variables - integer :: land_nt_local ! number of LAND tiles in local PE + integer :: nt_local ! number of tiles in local PE integer :: comm logical :: IAmRoot integer :: fdtstep - integer :: YEAR, DAY_OF_YEAR, SEC_OF_DAY,n - real, pointer :: LandTileLats(:) - real, pointer :: LandTileLons(:) + real, pointer :: TileLats(:) + real, pointer :: TileLons(:) real, allocatable :: zth(:), slr(:), zth_tmp(:) type(met_force_type), allocatable :: mfDataNtp(:) type(met_force_type), pointer, contiguous :: DataTmp(:)=>null() - real, allocatable :: tmpreal(:) type(met_force_type) :: mf_nodata logical :: MERRA_file_specs @@ -868,6 +926,7 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_UserCompGetInternalState(gc, 'METFORCE_state', wrap, status) VERIFY_(status) internal => wrap%ptr + tile_coord => internal%mf%tile_coord call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", & DEFAULT=1, RC=STATUS) @@ -877,9 +936,9 @@ subroutine Run(gc, import, export, clock, rc) VERIFY_(status) call MAPL_LocStreamGet( & locstream, & - NT_LOCAL=land_nt_local, & - TILELATS=LandTileLats, & - TILELONS=LandTileLons, & + NT_LOCAL=nt_local, & + TILELATS=TileLats, & + TILELONS=TileLons, & rc=status & ) VERIFY_(status) @@ -888,11 +947,11 @@ subroutine Run(gc, import, export, clock, rc) call MAPL_Get(MAPL, orbit=orbit) ! Allocate memory for zenith angle - allocate(zth(land_nt_local), source=nodata_generic, stat=status) + allocate(zth(nt_local), source=nodata_generic, stat=status) VERIFY_(status) - allocate(slr(land_nt_local), source=nodata_generic, stat=status) + allocate(slr(nt_local), source=nodata_generic, stat=status) VERIFY_(status) - allocate(zth_tmp(land_nt_local), source=nodata_generic, stat=status) + allocate(zth_tmp(nt_local), source=nodata_generic, stat=status) VERIFY_(status) ! Convert forcing time interval to seconds @@ -902,10 +961,6 @@ subroutine Run(gc, import, export, clock, rc) call ESMF_ClockGetAlarm(clock, 'MetForcing', MetForcingAlarm, rc=status) VERIFY_(status) - ! Get component's internal tile_coord variable - call ESMF_UserCompGetInternalState(gc, 'TILE_COORD', tcwrap, status) - VERIFY_(status) - tile_coord => tcwrap%ptr%tile_coord ! Time stamp of next model step ! -get-model-time-step- @@ -938,7 +993,7 @@ subroutine Run(gc, import, export, clock, rc) fdtstep, & internal%mf%Path, & internal%mf%Tag, & - land_nt_local, & + nt_local, & tile_coord, & internal%mf%hinterp, & AEROSOL_DEPOSITION, & @@ -956,8 +1011,8 @@ subroutine Run(gc, import, export, clock, rc) ! -compute-average-zenith-angle-over-daylight-part-of-forcing-interval- call MAPL_SunGetInsolation( & - LandTileLons, & - LandTileLats, & + TileLons, & + TileLats, & orbit, & zth_tmp, & slr, & @@ -973,7 +1028,7 @@ subroutine Run(gc, import, export, clock, rc) ! dayOfYear=DAY_OF_YEAR, RC=STATUS) ! VERIFY_(STATUS) - ! call zenith(DAY_OF_YEAR,SEC_OF_DAY,fdtstep,ModelTimeStep,land_nt_local,tile_coord%com_lon, & + ! call zenith(DAY_OF_YEAR,SEC_OF_DAY,fdtstep,ModelTimeStep,nt_local,tile_coord%com_lon, & ! tile_coord%com_lat,internal%mf%zenav) @@ -989,8 +1044,8 @@ subroutine Run(gc, import, export, clock, rc) ! Compute zenith angle at the next time step call MAPL_SunGetInsolation( & - LandTileLons, & - LandTileLats, & + TileLons, & + TileLats, & orbit, & zth_tmp, & slr, & @@ -1005,7 +1060,7 @@ subroutine Run(gc, import, export, clock, rc) !call ESMF_TimeGet(ModelTimeNxt, YY=YEAR, S=SEC_OF_DAY, & ! dayOfYear=DAY_OF_YEAR, RC=STATUS) !VERIFY_(STATUS) - !do n=1, land_nt_local + !do n=1, nt_local ! call solar(tile_coord(n)%com_lon,tile_coord(n)%com_lat, DAY_OF_YEAR,SEC_OF_DAY,zth(n),slr(n)) !enddo @@ -1028,7 +1083,7 @@ subroutine Run(gc, import, export, clock, rc) ! Allocate memory for interpolated MetForcing data mf_nodata = nodata_generic - allocate(mfDataNtp(land_nt_local), source=mf_nodata, stat=status) + allocate(mfDataNtp(nt_local), source=mf_nodata, stat=status) VERIFY_(status) ! Interpolate MetForcing data to the end of model integration time step @@ -1222,6 +1277,125 @@ subroutine Run(gc, import, export, clock, rc) end subroutine Run + subroutine DistributeForcetoLand(gc, export, land_import, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_State), intent(inout) :: land_import ! Import state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + real, pointer :: out1d(:), in1d(:) + real, pointer :: out2d(:,:), in2d(:,:) + integer :: k, AEROSOL_DEPOSITION, status + type(MAPL_MetaComp), pointer :: MAPL + character(len=ESMF_MAXSTR) :: Iam + Iam = "metForce::DistributeForcetoLand" + + call MAPL_GetObjectFromGC(gc, MAPL, _RC) + call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", DEFAULT=1, _RC) + if(AEROSOL_DEPOSITION /=0) then + do k = 1, k_aerosol + call MAPL_GetPointer(export, out2d, aerosol_name(k), _RC) + call MAPL_GetPointer(land_import, in2d, aerosol_name(k), _RC) + in2d(:,:) = out2d(1:NUM_LAND_TILE, :) + enddo + endif + + call MAPL_GetPointer(export, out1d, 'Psurf', _RC) + call MAPL_GetPointer(land_import, in1d, 'PS', _RC) + in1d = out1d(1:NUM_LAND_TILE) + call MAPL_GetPointer(export, out1d, 'RefH', _RC) + call MAPL_GetPointer(land_import, in1d, 'DZ', _RC) + in1d = out1d(1:NUM_LAND_TILE) + RETURN_(ESMF_SUCCESS) + end subroutine DistributeForcetoLand + + subroutine DistributeForcetoLandPert(gc, export, landpert_import, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_State), intent(inout) :: landpert_import ! Import state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + + real, pointer :: out1d(:), in1d(:) + integer :: k, status + character(len=ESMF_MAXSTR) :: Iam + Iam = "metForce::DistributeForcetoLandPert" + + do k = 1, k_force + call MAPL_GetPointer(export, out1d, trim(export_name(k)), _RC) + call MAPL_GetPointer(landpert_import, in1d, trim(export_name(k)), _RC) + in1d = out1d(1:NUM_LAND_TILE) + enddo + RETURN_(ESMF_SUCCESS) + end subroutine DistributeForcetoLandPert + + subroutine DistributeForcetoLandIce(gc, export, landice_import, clock, rc) + type(ESMF_GridComp), intent(inout) :: gc ! Gridded component + type(ESMF_State), intent(inout) :: export ! Export state + type(ESMF_State), intent(inout) :: landice_import ! Import state + type(ESMF_Clock), intent(inout) :: clock ! The clock + integer, optional, intent( out) :: rc ! Error code + integer :: k, i1, i2, AEROSOL_DEPOSITION, status + real, pointer :: out1d(:), in1d(:), tmp(:) + real, pointer :: out2d(:,:), in2d(:,:) + real, allocatable :: tmpreal(:) + type(MAPL_MetaComp), pointer :: MAPL + character(len=ESMF_MAXSTR) :: Iam + Iam = "metForce::DistributeForcetoLandice" + + if (NUM_LANDICE_TILE == 0) then + RETURN_(ESMF_SUCCESS) + endif + + i1 = NUM_LAND_TILE + 1 + i2 = NUM_LAND_TILE + NUM_LANDICE_TILE + ! Get MAPL obj + call MAPL_GetObjectFromGC(gc, MAPL, _RC) + call MAPL_GetResource ( MAPL, AEROSOL_DEPOSITION, Label="AEROSOL_DEPOSITION:", DEFAULT=1, _RC) + if(AEROSOL_DEPOSITION /=0) then + do k = 1, k_aerosol + call MAPL_GetPointer(export, out2d, aerosol_name(k), _RC) + call MAPL_GetPointer(landice_import, in2d, aerosol_name(k), _RC) + in2d(:,:) = out2d(i1:i2, :) + VERIFY_(status) + enddo + endif + + do k = 1, k_force - 2 + call MAPL_GetPointer(export, out1d, trim(export_name(k)), _RC) + call MAPL_GetPointer(landice_import, in1d, trim(landice_name(k)), _RC) + in1d = out1d(i1:i2) + enddo + + call MAPL_GetPointer(export, out1d, 'Wind', _RC) + call MAPL_GetPointer(landice_import, in1d, 'UWINDLMTILE', _RC) + in1d = out1d(i1:i2) + call MAPL_GetPointer(landice_import, in1d, 'VWINDLMTILE', _RC) + in1d = 0. + + call MAPL_GetPointer(export, out1d, 'Rainf', _RC) + call MAPL_GetPointer(export, tmp, 'Rainf_C', _RC) + call MAPL_GetPointer(landice_import, in1d, 'PLS', _RC) + in1d = out1d(i1:i2) - tmp(i1:i2) + + allocate(tmpreal(NUM_LANDICE_TILE), stat=status) + call MAPL_GetPointer(export, out1d, 'SWdown', _RC) + tmpreal = 0.5* out1d(i1:i2) + call MAPL_GetPointer(landice_import, in1d, 'DRNIR', _RC) + in1d = 0.5 * tmpreal + call MAPL_GetPointer(landice_import, in1d, 'DFNIR', _RC) + in1d = 0.5 * tmpreal + + call MAPL_GetPointer(export, out1d, 'PARdrct', _RC) + call MAPL_GetPointer(landice_import, in1d, 'DRUVR', _RC) + in1d = 0.5* tmpreal - out1d(i1:i2) + call MAPL_GetPointer(export, out1d, 'PARdffs', _RC) + call MAPL_GetPointer(landice_import, in1d, 'DFUVR', _RC) + in1d = 0.5* tmpreal - out1d(i1:i2) + deallocate(tmpreal) + + RETURN_(ESMF_SUCCESS) + end subroutine DistributeForcetoLandIce !BOP