SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/irrigation

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE IRRIGATION_UPDATE(PIRRIG, PTSTEP, KMONTH, KDAY,   &
00003        PTIME,TSEEDMONTH,TSEEDDAY,TREAPMONTH,TREAPDAY) 
00004 !     ####################################################################
00005 !
00006 !!****  *IRRIGATION_UPDATE* - routine to update irrigation fields
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!      P. Le Moigne  *Meteo France*    
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    06/2006
00032 !-------------------------------------------------------------------------------
00033 !
00034 !*       0.    DECLARATIONS
00035 !              ------------
00036 !
00037 USE MODD_AGRI,   ONLY   : JPSTAGE, XTHRESHOLD
00038 USE MODD_AGRI_n, ONLY   : NIRRINUM, LIRRIDAY, XTHRESHOLDSPT, LIRRIGATE
00039 !
00040 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00041 USE PARKIND1  ,ONLY : JPRB
00042 !
00043 IMPLICIT NONE
00044 INTEGER, DIMENSION(:,:), INTENT(IN) :: TSEEDMONTH
00045 INTEGER, DIMENSION(:,:), INTENT(IN) :: TSEEDDAY
00046 INTEGER, DIMENSION(:,:), INTENT(IN) :: TREAPMONTH
00047 INTEGER, DIMENSION(:,:), INTENT(IN) :: TREAPDAY
00048 REAL   , DIMENSION(:,:), INTENT(IN) :: PIRRIG
00049 REAL,    INTENT(IN)  :: PTSTEP, PTIME
00050 INTEGER, INTENT(IN)  :: KMONTH, KDAY
00051 INTEGER              :: IL, JL                        
00052 LOGICAL              :: GMASK
00053 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00054 !
00055 !*       0.1   Declarations of arguments
00056 !-------------------------------------------------------------------------------
00057 !
00058 ! Mask to realize update only once a day
00059 !
00060 IF (LHOOK) CALL DR_HOOK('MODI_IRRIGATION_UPDATE:IRRIGATION_UPDATE',0,ZHOOK_HANDLE)
00061 GMASK = ( PTIME - PTSTEP < 0. ) .AND. ( PTIME >= 0. )
00062 !
00063 IF (GMASK) THEN
00064 !
00065    WHERE( (PIRRIG(:,:).GT.0.).AND.(LIRRIDAY(:,:)) .AND.(NIRRINUM(:,:).LT.JPSTAGE))
00066       NIRRINUM (:,:) = NIRRINUM(:,:) + 1
00067       LIRRIDAY (:,:) = .FALSE.
00068    ENDWHERE
00069 !   
00070    DO IL=1,SIZE(PIRRIG,1)
00071        DO JL=1,SIZE(PIRRIG,2)
00072            XTHRESHOLDSPT(IL,JL)=XTHRESHOLD(NIRRINUM(IL,JL))
00073        ENDDO
00074    ENDDO
00075 !
00076 END IF
00077 !
00078 ! Reinitialization of irrigation stage (necessary for runs from August to August)
00079 !
00080 IF((KMONTH==1).AND.(KDAY==1)) THEN
00081    NIRRINUM(:,:) = 1
00082 ENDIF
00083 !
00084 LIRRIGATE(:,:) = .FALSE.
00085 DO IL=1,SIZE(PIRRIG,1)
00086    DO JL=1,SIZE(PIRRIG,2)
00087       !
00088       ! Activate irrigation after seeding date
00089       !
00090       IF (KMONTH == TSEEDMONTH(IL,JL) .AND. KDAY .GE. TSEEDDAY(IL,JL)) THEN
00091          LIRRIGATE(IL,JL) = .TRUE.
00092       END IF
00093       IF (KMONTH > TSEEDMONTH(IL,JL)) THEN
00094          LIRRIGATE(IL,JL) = .TRUE.
00095       END IF
00096       !
00097       ! Stop irrigation after reaping date
00098       !
00099       IF (KMONTH == TREAPMONTH(IL,JL) .AND. KDAY .GE. TSEEDDAY(IL,JL)) THEN
00100          LIRRIGATE(IL,JL) = .FALSE.
00101       END IF
00102       IF (KMONTH > TREAPMONTH(IL,JL)) THEN
00103          LIRRIGATE(IL,JL) = .FALSE.
00104       END IF
00105    ENDDO
00106 ENDDO
00107 IF (LHOOK) CALL DR_HOOK('MODI_IRRIGATION_UPDATE:IRRIGATION_UPDATE',1,ZHOOK_HANDLE)
00108 !
00109 END SUBROUTINE IRRIGATION_UPDATE