mo_prepare_gridded_lai.f90

Go to the documentation of this file.

!> \file mo_prepare_gridded_lai.f90
!> \brief \copybrief mo_prepare_gridded_lai
!> \details \copydetails mo_prepare_gridded_lai
 
!> \brief Prepare daily LAI fields (e.g., MODIS data) for mHM
!> \details Prepare daily LAI fields(e.g., MODIS data) for mHM
!> \authors John Craven & Rohini Kumar
!> \date Aug 2013
!> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
!! mHM is released under the LGPLv3+ license \license_note
!> \ingroup f_mpr
MODULE mo_prepare_gridded_lai
 
  ! This module provides routines to read daily gridded LAI data.
 
  ! Written  John Craven & Rohini Kumar, August 2013
  ! Modified from mo_meteo_forcings
 
  USE mo_kind, ONLY : i4, dp
  use mo_message, only: error_message
 
  IMPLICIT NONE
 
  PRIVATE
 
  PUBLIC :: prepare_gridded_daily_lai_data
  PUBLIC :: prepare_gridded_mean_monthly_lai_data
 
  ! ------------------------------------------------------------------
 
CONTAINS
 
  ! ------------------------------------------------------------------
 
  !    NAME
  !        prepare_gridded_daily_LAI_data
 
  !    PURPOSE
  !>       \brief Prepare gridded daily LAI data
 
  !>       \details Prepare gridded daily LAI data at Level-0 (e.g., using MODIS datasets)
 
  !    INTENT(IN)
  !>       \param[in] "integer(i4) :: iDomain, nrows, ncols" domain Id
  !>       \param[in] "integer(i4) :: iDomain, nrows, ncols" domain Id
  !>       \param[in] "integer(i4) :: iDomain, nrows, ncols" domain Id
  !>       \param[in] "logical, dimension(:, :) :: mask"
 
  !    INTENT(IN), OPTIONAL
  !>       \param[in] "type(period), optional :: LAIPer_iDomain"
 
  !    HISTORY
  !>       \authors John Craven & Rohini Kumar
 
  !>       \date Aug 2013
 
  ! Modifications:
  ! Matthias Cuntz & Juliane Mai Nov 2014 - use meteo reading routines
  ! Robert Schweppe Jun 2018 - refactoring and reformatting
 
  subroutine prepare_gridded_daily_lai_data(iDomain, nrows, ncols, mask, LAIPer_iDomain)
 
    use mo_append, only : append
    use mo_common_types, only: period
    use mo_mpr_global_variables, only : l0_gridded_lai, dirgridded_lai, inputformat_gridded_lai, &
            nlai, laiboundaries, timestep_lai_input
    use mo_read_nc, only : read_nc
 
    implicit none
 
    ! domain Id
    integer(i4), intent(in) :: idomain, nrows, ncols
 
    logical, dimension(:, :), intent(in) :: mask
 
    type(period), intent(in), optional :: laiper_idomain
 
    integer(i4) :: ncells, ilai
 
    ! data at level-0 [nRow X nCols X nTimeSteps]
    real(dp), dimension(:, :, :), allocatable :: lai0_3d
 
    ! data at level-0 [nCells X nTimeSteps]
    real(dp), dimension(:, :), allocatable :: lai0_2d
 
 
    ! select case depending on input data format
    SELECT CASE(trim(inputformat_gridded_lai))
 
    ! netcdf file input option
    CASE('nc')
      CALL read_nc(dirgridded_lai(idomain), nrows, ncols, &
              'lai', mask, lai0_3d, target_period = laiper_idomain, &
              lower = 1.00e-10_dp, upper = 30.0_dp, nctimestep = timestep_lai_input)
    CASE DEFAULT
      call error_message('***ERROR: No recognized input format')
 
    END SELECT
 
    ! pack variables
    ncells = count(mask)
    ! only set if not yet allocated (e.g. domain 1)
    if (.not. allocated(laiboundaries)) then
      nlai = size(lai0_3d, 3)
      allocate(laiboundaries(nlai+1))
      laiboundaries = [(ilai, ilai=1, nlai+1)]
    end if
    allocate(lai0_2d(ncells, nlai))
 
    do ilai = 1, nlai
      lai0_2d(:, ilai) = pack(lai0_3d(:, :, ilai), mask = mask(:, :))
    end do
 
    ! append to Global variable
    call append(l0_gridded_lai, lai0_2d(:, :))
 
    !free space
    deallocate(lai0_2d, lai0_3d)
 
  end subroutine prepare_gridded_daily_lai_data
 
  ! ------------------------------------------------------------------
 
  !    NAME
  !        prepare_gridded_mean_monthly_LAI_data
 
  !    PURPOSE
  !>       \brief prepare_gridded_mean_monthly_LAI_data
 
  !>       \details Long term mean monthly gridded LAI data at Level-0 (e.g., using MODIS datasets)
  !>       The netcdf file should contain 12 (calender months) gridded fields of climatological
  !>       LAI data at the input L0 data resolution.
 
  !    INTENT(IN)
  !>       \param[in] "integer(i4) :: iDomain, nrows, ncols" domain Id
  !>       \param[in] "integer(i4) :: iDomain, nrows, ncols" domain Id
  !>       \param[in] "integer(i4) :: iDomain, nrows, ncols" domain Id
  !>       \param[in] "logical, dimension(:, :) :: mask"
 
  !    HISTORY
  !>       \authors Rohini Kumar
 
  !>       \date Dec 2016
 
  ! Modifications:
  ! Robert Schweppe Jun 2018 - refactoring and reformatting
 
  subroutine prepare_gridded_mean_monthly_lai_data(iDomain, nrows, ncols, mask)
 
    use mo_append, only : append
    use mo_mpr_global_variables, only : l0_gridded_lai, dirgridded_lai, nlai, laiboundaries
    use mo_common_constants, only : defaulttolerance_dp
    use mo_netcdf, only : ncdataset, ncvariable
    use mo_string_utils, only : num2str
    use mo_utils, only : eq
 
    implicit none
 
    ! domain Id
    integer(i4), intent(in) :: idomain, nrows, ncols
 
    logical, dimension(:, :), intent(in) :: mask
 
    integer(i4) :: ncells, ilai
 
    ! data at level-0 [nRow X nCols X nTimeSteps]
    real(dp), dimension(:, :, :), allocatable :: lai0_3d
 
    ! data at level-0 [nCells X nTimeSteps]
    real(dp), dimension(:, :), allocatable :: lai0_2d
 
    integer(i4) :: t
 
    ! name of NetCDF file
    character(256) :: fname
 
    type(ncdataset) :: nc
 
    type(ncvariable) :: var
 
    ! dimension for NetCDF file
    integer(i4), dimension(:), allocatable :: dimen
 
    ! data nodata value
    real(dp) :: nodata_value
 
 
    fname = trim(dirgridded_lai(idomain)) // trim('lai.nc')
 
    nc = ncdataset(trim(fname), "r")
    var = nc%getVariable('lai')
 
    ! get dimensions
    dimen = var%getShape()
    if ((dimen(1) .ne. nrows) .or. (dimen(2) .ne. ncols)) then
       call error_message('***ERROR: read_nc: mHM generated x and y are not matching NetCDF dimensions')
    end if
    if (dimen(3) .ne. 12) then
       call error_message('***ERROR: read_nc: the time dimenion of LAI NetCDF file under the option-1 is not 12')
    end if
 
    ! determine no data value
    call var%getAttribute('_FillValue', nodata_value)
 
    call var%getData(lai0_3d)
    call nc%close()
 
    ! start checking values
    do t = 1, dimen(3)
      ! checking for nodata values if optional nocheck is given
      if (any(eq(lai0_3d(:, :, t), nodata_value) .and. (mask))) then
        call error_message('***ERROR: read_nc: nodata value within domain ', raise=.false.)
        call error_message('          boundary in variable: ', 'lai', raise=.false.)
        call error_message('          at timestep         : ', trim(num2str(t)))
      end if
      ! optional check
      if (any((lai0_3d(:, :, t) .lt. 0.0_dp) .AND. mask(:, :))) then
        ! if difference is less than a small tolerance, set to zero
        if (all((lai0_3d(:, :, t) .gt. -defaulttolerance_dp) .AND. mask(:, :))) then
          lai0_3d(:, :, t) = max(lai0_3d(:, :, t), 0.0_dp)
          cycle
        end if
        call error_message('***ERROR: read_nc: values in variable lai are lower than ', trim(num2str(0, '(F7.2)')), raise=.false.)
        call error_message('          at timestep  : ', trim(num2str(t)), raise=.false.)
        call error_message('File: ', trim(fname), raise=.false.)
        call error_message('Minval at timestep: ', trim(num2str(minval(lai0_3d(:, :, t)), '(F7.2)')), raise=.false.)
        call error_message('Total minval: ', trim(num2str(minval(lai0_3d(:, :, :)), '(F7.2)')))
      end if
 
      if (any((lai0_3d(:, :, t) .gt. 30.0_dp) .AND. mask(:, :))) then
        call error_message('***ERROR: read_nc: values in variable lai are greater than ', trim(num2str(30, '(F7.2)')), raise=.false.)
        call error_message('          at timestep  : ', trim(num2str(t)), raise=.false.)
        call error_message('File: ', trim(fname), raise=.false.)
        call error_message('Maxval at timestep: ', trim(num2str(maxval(lai0_3d(:, :, t)), '(F7.2)')), raise=.false.)
        call error_message('Total maxval: ', trim(num2str(maxval(lai0_3d(:, :, :)), '(F7.2)')))
      end if
    end do
 
    ! pack variables
    ncells = count(mask)
    ! only set if not yet allocated (e.g. domain 1)
    if (.not. allocated(laiboundaries)) then
      nlai = size(lai0_3d, 3)
      allocate(laiboundaries(nlai+1))
      laiboundaries = [(ilai, ilai=1, nlai+1)]
    end if
    allocate(lai0_2d(ncells, nlai))
    do ilai = 1, nlai
      lai0_2d(:, ilai) = pack(lai0_3d(:, :, ilai), mask = mask(:, :))
    end do
 
    ! append to Global variable
    call append(l0_gridded_lai, lai0_2d(:, :))
 
    !free space
    deallocate(lai0_2d, lai0_3d)
 
  end subroutine prepare_gridded_mean_monthly_lai_data
 
 
END MODULE mo_prepare_gridded_lai