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

Go to the documentation of this file.
00001 !     #######################################################
00002       SUBROUTINE SUBSTRACT_TO_DATE_SURF(KYEAR,KMONTH,KDAY,PSEC)
00003 !     #######################################################
00004 !
00005 !!****  *SUBSTRACT_TO_DATE_SURF* - finds the current date and hour from a date
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!                                WARNING
00011 !!
00012 !!      -----> Only correct for dates between 19900301 and 21000228   <-----
00013 !!
00014 !!  The correct test should be:
00015 !! IF( ((MOD(KYEAR,4)==0).AND.(MOD(KYEAR,100)/=0)) .OR. (MOD(KYEAR,400)==0))THEN
00016 !!
00017 !!**  METHOD
00018 !!    ------
00019 !!
00020 !!      A recursive method is used, removing one day ofter the other.
00021 !!
00022 !!    EXTERNAL
00023 !!    --------
00024 !!
00025 !!    IMPLICIT ARGUMENTS
00026 !!    ------------------
00027 !!
00028 !!    REFERENCE
00029 !!    ---------
00030 !!
00031 !!    Book 2 (add_forecast_to_date)
00032 !!
00033 !!    AUTHOR
00034 !!    ------
00035 !!      
00036 !     G.Jaubert Meteo-France (from add_forecast_to_date)
00037 !!
00038 !!    MODIFICATIONS
00039 !!    -------------
00040 !!      Original    23/07/01
00041 !-------------------------------------------------------------------------------
00042 !
00043 !*       0.    DECLARATIONS
00044 !              ------------
00045 !
00046 !
00047 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00048 USE PARKIND1  ,ONLY : JPRB
00049 !
00050 IMPLICIT NONE
00051 !
00052 !*       0.1   Declaration of arguments
00053 !              ------------------------
00054 INTEGER, INTENT(INOUT) :: KYEAR  ! year of date
00055 INTEGER, INTENT(INOUT) :: KMONTH ! month of date
00056 INTEGER, INTENT(INOUT) :: KDAY   ! day of date
00057 REAL,    INTENT(INOUT) :: PSEC   ! number of seconds since date at 00 UTC
00058 !
00059 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00060 !-------------------------------------------------------------------------------
00061 IF (LHOOK) CALL DR_HOOK('SUBSTRACT_TO_DATE_SURF',0,ZHOOK_HANDLE)
00062 !
00063 !*       1.    Return condition: PSEC >0
00064 !              -------------------------
00065 !
00066 DO 
00067   IF (PSEC >= 0.) EXIT
00068 !
00069 !-------------------------------------------------------------------------------
00070 !
00071 !*       2.    remove one day
00072 !              --------------
00073 !
00074   PSEC=PSEC+86400.
00075 !
00076 !
00077 !*       2.1   first day of the month
00078 !              ---------------------
00079 !
00080   IF (KDAY==1) THEN
00081     IF (KMONTH==1) THEN
00082       KDAY=31
00083       KMONTH=12
00084       KYEAR=KYEAR-1
00085     ELSE
00086       KMONTH=KMONTH-1
00087       SELECT CASE (KMONTH)
00088         CASE(4,6,9,11)
00089           KDAY=30
00090         CASE(1,3,5,7:8,10,12)
00091           KDAY=31
00092         CASE(2)
00093           IF( ((MOD(KYEAR,4)==0).AND.(MOD(KYEAR,100)/=0)) .OR. (MOD(KYEAR,400)==0))THEN
00094             KDAY=29
00095           ELSE
00096             KDAY=28
00097           ENDIF
00098       END SELECT
00099     ENDIF
00100 ! 
00101 !*       2.2   Other days
00102 !              ----------
00103   ELSE
00104     KDAY=KDAY-1
00105   ENDIF
00106 !
00107 !-------------------------------------------------------------------------------
00108 !
00109 !*       3.    Recursive call
00110 !              --------------
00111 !
00112 ENDDO
00113 !
00114 IF (LHOOK) CALL DR_HOOK('SUBSTRACT_TO_DATE_SURF',1,ZHOOK_HANDLE)
00115 !-------------------------------------------------------------------------------
00116 !
00117 END SUBROUTINE SUBSTRACT_TO_DATE_SURF