diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index 13632f526..4867650d6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -3114,6 +3114,15 @@ subroutine SetServices ( GC, RC ) UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__) + + ! flammability and ignition sources + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'VPD', & + LONG_NAME = 'vapor pressure deficit', & + UNITS = 'Pa', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) end if @@ -5343,6 +5352,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: FWI_DAILY_ => NULL() real, pointer, dimension(:,:) :: DSR_DAILY_ => NULL() + real, pointer, dimension(:,:) :: VPD => NULL() + ! These are the tile versions of the imports real, pointer, dimension(:) :: PSTILE => NULL() @@ -5632,6 +5643,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:) :: FWIDAILYTILE_ => NULL() real, pointer, dimension(:) :: DSRDAILYTILE_ => NULL() + real, pointer, dimension(:) :: VPDTILE => NULL() + real, pointer, dimension(:,:) :: TMP => NULL() real, pointer, dimension(:,:) :: TTM => NULL() @@ -6496,6 +6509,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , BUI_DAILY_ , 'BUI_DAILY_' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ISI_DAILY_ , 'ISI_DAILY_' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DSR_DAILY_ , 'DSR_DAILY_' , RC=STATUS); VERIFY_(STATUS) + + call MAPL_GetPointer(EXPORT , VPD , 'VPD' , RC=STATUS); VERIFY_(STATUS) end if ! Force allocation for ice fraction for lwi mask @@ -7098,6 +7113,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MKTILE(BUI_DAILY_, BUIDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(ISI_DAILY_, ISIDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(DSR_DAILY_, DSRDAILYTILE_, NT, RC=STATUS); VERIFY_(STATUS) + + call MKTILE(VPD, VPDTILE, NT, RC=STATUS); VERIFY_(STATUS) end if @@ -8100,6 +8117,10 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_LocStreamTransform(LOCSTREAM, DSR_DAILY_, DSRDAILYTILE_, RC=STATUS) VERIFY_(STATUS) end if + if (associated(VPD)) then + call MAPL_LocStreamTransform(LOCSTREAM, VPD, VPDTILE, RC=STATUS) + VERIFY_(STATUS) + end if ! Fill exports computed on agcm grid @@ -9103,6 +9124,9 @@ subroutine DOTYPE(type,RC) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'DSR_DAILY_', ALLOC=associated(DSRDAILYTILE_), notFoundOK=.true., RC=STATUS) VERIFY_(STATUS) + + call MAPL_GetPointer(GEX(type), dum, 'VPD', ALLOC=associated(VPDTILE), notFoundOK=.true., RC=STATUS) + VERIFY_(STATUS) end if @@ -9976,6 +10000,10 @@ subroutine DOTYPE(type,RC) if (associated(DSRDAILYTILE_)) then call FILLOUT_TILE(GEX(type), 'DSR_DAILY_', DSRDAILYTILE_, XFORM, RC=STATUS) VERIFY_(STATUS) + end if + if (associated(VPDTILE)) then + call FILLOUT_TILE(GEX(type), 'VPD', VPDTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 index 1e3fd216d..1d68bb3f2 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90 @@ -1380,6 +1380,8 @@ subroutine SetServices ( GC, RC ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'BUI_DAILY_', CHILD_ID = IGNI, __RC__ ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'FWI_DAILY_', CHILD_ID = IGNI, __RC__ ) call MAPL_AddExportSpec ( GC, SHORT_NAME = 'DSR_DAILY_', CHILD_ID = IGNI, __RC__ ) + + call MAPL_AddExportSpec ( GC, SHORT_NAME = 'VPD', CHILD_ID = IGNI, __RC__ ) end if diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 index 4c8753e4a..e41e20a46 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90 @@ -558,15 +558,15 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone, __RC__) - ! misc -#if (0) + ! flammability and ignition sources + call MAPL_AddExportSpec(GC, & SHORT_NAME = 'VPD', & - LONG_NAME = 'vapor pressure defficit', & - UNITS = '1', & + LONG_NAME = 'vapor pressure deficit', & + UNITS = 'Pa', & DIMS = MAPL_DimsTileOnly, & VLOCATION = MAPL_VLocationNone, __RC__) -#endif + !EOS @@ -724,6 +724,12 @@ subroutine RUN2 (GC, IMPORT, EXPORT, CLOCK, RC) call MAPL_TimerOff(MAPL, '-CFFWI') +! flammability and ignition sources +! --------------------------------- + call REBURN(GC, IMPORT, EXPORT, CLOCK, __RC__) + + + ! All done ! --------- call MAPL_TimerOff(MAPL, 'RUN' ) @@ -1310,6 +1316,115 @@ subroutine CFFWI_HOURLY (GC, IMPORT, EXPORT, CLOCK, RC) end subroutine CFFWI_HOURLY +! ----------------------------------------------------------- +! REBURN -- flammability and ignition sources +! ----------------------------------------------------------- + + subroutine REBURN (GC, IMPORT, EXPORT, CLOCK, RC) + +! ----------------------------------------------------------- +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC + type(ESMF_State), intent(inout) :: IMPORT + type(ESMF_State), intent(inout) :: EXPORT + type(ESMF_Clock), intent(inout) :: CLOCK + integer, optional, intent( out) :: RC + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + + +! IMPORT pointers + + real, dimension(:), pointer :: T2M => null() + real, dimension(:), pointer :: Q2M => null() + real, dimension(:), pointer :: PS => null() + + +! INTERNAL pointers +! None + + +! EXPORT pointers + + real, dimension(:), pointer :: VPD => null() + + +! misc + + type(MAPL_MetaComp), pointer :: MAPL => null() + type(ESMF_State) :: INTERNAL + + integer :: NT + + real, pointer, dimension(:) :: LATS => null() + real, pointer, dimension(:) :: LONS => null() + + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + + Iam = trim(COMP_NAME) // 'REBURN' + + +! Get my internal MAPL_Generic state +! ----------------------------------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + + call MAPL_Get(MAPL, TILELATS=LATS, & + TILELONS=LONS, & + INTERNAL_ESMF_STATE=INTERNAL, __RC__) + + NT = SIZE(LONS) + + NO_LAND_AREAS: if (NT == 0) then + RETURN_(ESMF_SUCCESS) + end if NO_LAND_AREAS + + + +! Get pointers to imports +! ----------------------- + + call MAPL_GetPointer(IMPORT, PS, 'PS', __RC__) + call MAPL_GetPointer(IMPORT, Q2M, 'MOQ2M', __RC__) + call MAPL_GetPointer(IMPORT, T2M, 'MOT2M', __RC__) + + +! Get pointers to exports +! ----------------------- + + call MAPL_GetPointer(EXPORT, VPD, 'VPD', __RC__) + + +! Update diagnostics +! ------------------------- + UPDATE_VPD: if (associated(VPD)) then + ! VPD = e_s - e = e_s * (1 - RH) + ! + ! e_s = P * Qsat/(MAPL_EPSILON + (1 - MAPL_EPSILON)*Qsat) + ! MAPL_EQsat(T) is equivalent to the e_s expression + + VPD = MAPL_EQsat(T2M) * (1 - min(Q2M / GEOS_QSAT(T2M, PS, PASCALS=.true.), 1.0)) + end if UPDATE_VPD + + +! All done +! --------- + + RETURN_(ESMF_SUCCESS) + + end subroutine REBURN @@ -1359,16 +1474,16 @@ subroutine cffwi_daily_driver(ffmc, dmc, dc, isi, bui, fwi, dsr, & end if ! calculate ISI, BUI, FWI and DSR - isi(i) = initial_spread_index(ffmc(i), wind(i)) + isi(i) = initial_spread_index(ffmc(i), wind(i)) - if (snow_depth(i) > 1e-3) then - isi(i) = max(0.0, (1 - f_snow(i))) * isi(i) + if (snow_depth(i) > 1e-3) then + isi(i) = (1 - f_snow(i)) * isi(i) end if - bui(i) = buildup_index(dmc(i), dc(i)) + bui(i) = buildup_index(dmc(i), dc(i)) - fwi(i) = fire_weather_index(isi(i), bui(i)) - dsr(i) = daily_severity_rating(fwi(i)) + fwi(i) = fire_weather_index(isi(i), bui(i)) + dsr(i) = daily_severity_rating(fwi(i)) end do end subroutine cffwi_daily_driver @@ -1417,16 +1532,16 @@ subroutine cffwi_hourly_driver(ffmc, gfmc, dmc, dc, isi, bui, fwi, dsr, & swdown(i), NOMINAL_FINE_FUEL_LOAD, time_step) ! calculate ISI, BUI, FWI and DSR - isi(i) = initial_spread_index(ffmc(i), wind(i)) + isi(i) = initial_spread_index(ffmc(i), wind(i)) - if (snow_depth(1) > 1e-3) then - isi(i) = max(0.0, (1 - f_snow(i))) * isi(i) + if (snow_depth(1) > 1e-3) then + isi(i) = (1 - f_snow(i)) * isi(i) end if - bui(i) = buildup_index(dmc(i), dc(i)) + bui(i) = buildup_index(dmc(i), dc(i)) - fwi(i) = fire_weather_index(isi(i), bui(i)) - dsr(i) = daily_severity_rating(fwi(i)) + fwi(i) = fire_weather_index(isi(i), bui(i)) + dsr(i) = daily_severity_rating(fwi(i)) end do end subroutine cffwi_hourly_driver