Skip to content

Commit

Permalink
Merge branch 'develop' into feature/rreichle/make_bcs_cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
@sdrabenh
sdrabenh committed Mar 6, 2023
2 parents e55c581 + 7028ee0 commit 2f39435
Show file tree
Hide file tree
Showing 3 changed files with 162 additions and 17 deletions.
28 changes: 28 additions & 0 deletions GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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


Expand Down Expand Up @@ -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()
Expand Down Expand Up @@ -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()
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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


Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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


Expand Down Expand Up @@ -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


Expand Down
2 changes: 2 additions & 0 deletions ...ridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOS_LandGridComp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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


Expand Down
149 changes: 132 additions & 17 deletions ...s_GridComp/GEOSsurface_GridComp/GEOSland_GridComp/GEOSigni_GridComp/GEOS_IgniGridComp.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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' )
Expand Down Expand Up @@ -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



Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 2f39435

Please sign in to comment.