irrigation_update.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE irrigation_update (NAG, NPE, KPATCH, PTSTEP, KMONTH, KDAY, PTIME) 
!     ####################################################################
!
!!****  *IRRIGATION_UPDATE* - routine to update irrigation fields
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      P. Le Moigne  *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    06/2006
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_isba_n, ONLY : isba_npe_t
USE modd_agri_n, ONLY : agri_np_t
!
USE modd_agri,   ONLY   : jpstage, xthreshold
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
TYPE(isba_npe_t), INTENT(INOUT) :: NPE
TYPE(agri_np_t), INTENT(INOUT) :: NAG
!
INTEGER, INTENT(IN) :: KPATCH
REAL,    INTENT(IN)  :: PTSTEP, PTIME
INTEGER, INTENT(IN)  :: KMONTH, KDAY
!
INTEGER              :: JI, JP
LOGICAL              :: GMASK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*       0.1   Declarations of arguments
!-------------------------------------------------------------------------------
!
! Mask to realize update only once a day
!
IF (lhook) CALL dr_hook('MODI_IRRIGATION_UPDATE:IRRIGATION_UPDATE',0,zhook_handle)
gmask = ( ptime - ptstep < 0. ) .AND. ( ptime >= 0. )
!
DO jp = 1,kpatch
  !
  IF (gmask) THEN
    !
    WHERE( (npe%AL(jp)%XIRRIG(:).GT.0.).AND.(nag%AL(jp)%LIRRIDAY(:)) .AND.(nag%AL(jp)%NIRRINUM(:).LT.jpstage))
      nag%AL(jp)%NIRRINUM (:) = nag%AL(jp)%NIRRINUM(:) + 1
      nag%AL(jp)%LIRRIDAY (:) = .false.
    ENDWHERE
    !
    DO ji = 1,SIZE(npe%AL(jp)%XIRRIG,1)
      nag%AL(jp)%XTHRESHOLDSPT(ji)= xthreshold(nag%AL(jp)%NIRRINUM(ji))
    ENDDO
    !
  END IF
  !
  ! Reinitialization of irrigation stage (necessary for runs from August to August)
  !
  IF((kmonth==1).AND.(kday==1)) nag%AL(jp)%NIRRINUM(:) = 1
  !
  nag%AL(jp)%LIRRIGATE(:) = .false.
  !
  DO ji = 1,SIZE(npe%AL(jp)%XIRRIG,1)
    !
    ! Activate irrigation after seeding date
    !
    IF (kmonth == npe%AL(jp)%TSEED(ji)%TDATE%MONTH .AND. kday .GE. npe%AL(jp)%TSEED(ji)%TDATE%DAY) THEN
      nag%AL(jp)%LIRRIGATE(ji) = .true.
    END IF
    IF (kmonth > npe%AL(jp)%TSEED(ji)%TDATE%MONTH) THEN
      nag%AL(jp)%LIRRIGATE(ji) = .true.
    END IF
    !
    ! Stop irrigation after reaping date
    !
    IF (kmonth == npe%AL(jp)%TREAP(ji)%TDATE%MONTH .AND. kday .GT. npe%AL(jp)%TREAP(ji)%TDATE%DAY) THEN
      nag%AL(jp)%LIRRIGATE(ji) = .false.
    END IF
    IF (kmonth > npe%AL(jp)%TREAP(ji)%TDATE%MONTH) THEN
      nag%AL(jp)%LIRRIGATE(ji) = .false.
    END IF
  ENDDO
  !
ENDDO
!
IF (lhook) CALL dr_hook('MODI_IRRIGATION_UPDATE:IRRIGATION_UPDATE',1,zhook_handle)
!
END SUBROUTINE irrigation_update