TreeMig/Fortran_Code_Docu_html/GetBioclim_8f90_source.html

!==============================================================================

!   @brief GetBioClim

!   ****************

!  @details samples actual values of bioclimate (DD, WiT, DrStr) from interpolated means and standard deviations of the variables

!  @todo CURRENTLY NOT USED

!

!  -  ***USE:*** All_par

!  -  ***IN:***

!   - @param  year              : current year (relative years)

!     @param  lat, lon          : coordinates (relative) of actual cell

!

!   - *FROM All_par*

!       - newBioClim, oldBioClim   :TYPE(BIOCLIMDATA)  :   bioclimate data for this year and last stored year

!       - simustartyear            : INTEGER           :  start year of simulation in real years

!  -  ***OUT:***

!   - @param ddegs       : current value in grid cell of day degree sum [°C]

!     @param wtemp       : current value in grid cell of minimum winter temperature [°C]

!     @param drstr       : current value in grid cell of drought stress

!  -  ***CALLED FROM:***

!   - GetEnvFactors    in GetEnvFactors.f90

!===============================================================

! SUBROUTINE GetBioClim(year, lat, lon, ddegs, wtemp, drstr)

!

! !CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------

!     use All_par, only: newBioClim, oldBioClim, simustartyear

!

!     IMPLICIT NONE

!

! !Passed variables>--------------------------------------------------------------------------------

!     INTEGER, INTENT(in) :: year, lat, lon

!     REAL, INTENT(out)   :: ddegs, wtemp, drstr

!

! !Local variables>---------------------------------------------------------------------------------

!     REAL :: muDD, stdDD, muWiT, stdWiT, prop0DrStr, muDrStr, stdDrStr, oldT, newT, randomvalue, real_year

!

! !Here the SUBROUTINE starts>**********************************************************************

!     real_year = year + simustartyear

!     oldT = oldBioClim%cctime

!     newT = newBioClim%cctime

! !---- interpolate linearly mean and standard deviation between the last and the current time point of the bioclimate data

! !---- then sample a value from the normal distribution described by these parameters  (GetVariate)

!  !---- DD

!     call Interpolate(real_year, oldT, newT, oldBioClim%bc(lat, lon)%muDD, &

!                      newBioClim%bc(lat, lon)%muDD, muDD)

!     call Interpolate(real_year, oldT, newT, oldBioClim%bc(lat, lon)%stdDD, &

!                      newBioClim%bc(lat, lon)%stdDD, stdDD)

!     call GetVariate(muDD, stdDD, ddegs)

!  !---- WiT

!     call Interpolate(real_year, oldT, newT, oldBioClim%bc(lat, lon)%muWiT, &

!                      newBioClim%bc(lat, lon)%muWiT, muWiT)

!     call Interpolate(real_year, oldT, newT, oldBioClim%bc(lat, lon)%stdWiT, &

!                      newBioClim%bc(lat, lon)%stdWiT, stdWiT)

!     call GetVariate(muWiT, stdWiT, wtemp)

!   !---- Drought stress, first pro0DrStr

!   call Interpolate(real_year, oldT, newT, oldBioClim%bc(lat, lon)%prop0DrStr, &

!                      newBioClim%bc(lat, lon)%prop0DrStr, prop0DrStr)

!     call RANDOM_NUMBER(randomvalue)

!

!     if (randomvalue <= prop0DrStr) then

!         drstr = 0.0

!     else

!   !---- Drought stress, interpolate and sample

!         call Interpolate(real_year, oldT, newT, oldBioClim%bc(lat, lon)%muDrStr, &

!                          newBioClim%bc(lat, lon)%muDrStr, muDrStr)

!         call Interpolate(real_year, oldT, newT, oldBioClim%bc(lat, lon)%stdDrStr, &

!                          newBioClim%bc(lat, lon)%stdDrStr, stdDrStr)

!

!         call GetVariate(muDrStr, stdDrStr, drstr)

!         if (drstr < 0.0) drstr = 0.0

!         if (drstr > 1.0) drstr = 1.0

!     end if

!

! end SUBROUTINE GetBioClim

!

!==============================================================================

!===============================================================


SUBROUTINE getbioclimsimple(year, lat, lon, ddegs, wtemp, drstr, avnit, brwpr, disturb, germDrought)


!CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------

    use all_par, only: newbioclim


    IMPLICIT NONE


!Passed variables>--------------------------------------------------------------------------------

    INTEGER, INTENT(in) :: year, lat, lon

    REAL, INTENT(out)   :: ddegs, wtemp, drstr, disturb, germDrought, avnit, brwpr


!Local variables>---------------------------------------------------------------------------------

    ddegs = newbioclim%bc(lat, lon)%muDD

    wtemp = newbioclim%bc(lat, lon)%muWiT

    drstr = newbioclim%bc(lat, lon)%muDrStr

    disturb = newbioclim%bc(lat, lon)%disturb

    germdrought =newbioclim%bc(lat, lon)%germDrought

    brwpr =newbioclim%bc(lat, lon)%brwpr

    avnit =newbioclim%bc(lat, lon)%avnit

    if (drstr < 0.0) drstr = 0.0

    if (drstr > 1.0) drstr = 1.0


end SUBROUTINE getbioclimsimple


!==============================================================================

!===============================================================

! SUBROUTINE Interpolate(x, x1, x2, y1, y2, y)

!     use LoggerModule

!     !CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------

!     IMPLICIT NONE

!

!     !Passed variables>--------------------------------------------------------------------------------

!     REAL, INTENT(in) :: x, x1, x2, y1, y2

!     REAL, INTENT(out):: y

!

!     !Here the SUBROUTINE starts>**********************************************************************

!     if (abs(x1 - x2) < 1.E-20) then

!         call LogError("x1 = x2 on interpolation: ")

!         write(LogMessage, "(2F15.6)") x1, x2

!         call LogError(LogMessage)

!         error stop

!     end if

!

!     y = y1 + (x - x1)*(y2 - y1)/(x2 - x1)

! end SUBROUTINE Interpolate

!

!==============================================================================

!===============================================================

! SUBROUTINE GetVariate(mu, stdev, x)

!

!     !CALL modules for TYPE definitions and +- fixed variables>---------------------------------------------------------------

!     IMPLICIT NONE

!

!     !Passed variables>--------------------------------------------------------------------------------

!     REAL, INTENT(in)  :: mu, stdev

!     REAL, INTENT(out) :: x

!

!     !Local variables>---------------------------------------------------------------------------------

!     REAL :: randomvalue

!

!     !Here the SUBROUTINE starts>**********************************************************************

!     call RANDOM_NUMBER(randomvalue)

!     call DrawFromNormalDist(mu, stdev, x, randomvalue)

!

! end SUBROUTINE GetVariate

!done

getbioclimsimple
subroutine getbioclimsimple(year, lat, lon, ddegs, wtemp, drstr, avnit, brwpr, disturb, germdrought)
GetBioClimSimple.
Definition GetBioclim.f90:98

all_par
Definition All_par.f90:20

all_par::newbioclim
type(bioclimdata) newbioclim
Definition All_par.f90:351