SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/get_date

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE GET_DATE_OL(TPTIME,PTSTEP,HDATE)
00003 !     #######################################################
00004 !!****  *GET_DATE_OL* - gets the initial date of the simulation to write in
00005 !                       netcdf file
00006 !!
00007 !!    PURPOSE
00008 !!    -------
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 !!      S. Faroux   *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    06/2010 
00032 !-------------------------------------------------------------------------------
00033 !
00034 USE MODD_TYPE_DATE_SURF, ONLY: DATE_TIME
00035 !
00036 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00037 USE PARKIND1  ,ONLY : JPRB
00038 !
00039 IMPLICIT NONE
00040 !
00041 TYPE(DATE_TIME), INTENT(IN)      :: TPTIME      ! current date and time
00042 REAL,            INTENT(IN)      :: PTSTEP
00043  CHARACTER(LEN=*), INTENT(OUT)    :: HDATE
00044 !
00045 INTEGER, DIMENSION(3)            :: ITIME, IDATE
00046 INTEGER                          :: INDAYS
00047 INTEGER                          :: ISEC
00048 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00049 !
00050 !-------------------------------------------------------------------------------
00051 !
00052 !
00053 IF (LHOOK) CALL DR_HOOK('GET_DATE_OL',0,ZHOOK_HANDLE)
00054 INDAYS = FLOOR(PTSTEP/86400)
00055 ISEC=MAX(0,NINT(TPTIME%TIME-(PTSTEP-INDAYS*86400)))
00056 ITIME(1)=FLOOR(ISEC/3600.)
00057 ITIME(2)=FLOOR((ISEC-ITIME(1)*3600)/60.)
00058 ITIME(3)=ISEC-ITIME(1)*3600-ITIME(2)*60 
00059 !
00060 IF (PTSTEP == FLOOR(PTSTEP/86400.)*86400) THEN 
00061   HDATE='days since '
00062 ELSEIF (PTSTEP == FLOOR(PTSTEP/3600.)*3600) THEN
00063   HDATE='hours since '
00064 ELSEIF (PTSTEP == FLOOR(PTSTEP/60.)*60) THEN
00065   HDATE='minutes since '
00066 ELSE
00067   HDATE='seconds since '
00068 ENDIF
00069 !
00070 IDATE(1) = TPTIME%TDATE%YEAR
00071 IDATE(2) = TPTIME%TDATE%MONTH
00072 IDATE(3) = TPTIME%TDATE%DAY
00073 !
00074 IF (INDAYS.NE.0) THEN
00075   IF (IDATE(3).GE.INDAYS+1) THEN
00076     IDATE(3) = IDATE(3) - INDAYS
00077   ELSE
00078     IF (IDATE(2).GE.2) THEN
00079       IDATE(2) = IDATE(2) - 1
00080       IDATE(3) = IDATE(3) - INDAYS
00081     ELSE
00082       IDATE(1) = IDATE(1) - 1
00083       IDATE(2) = 12
00084       IDATE(3) = IDATE(3) - INDAYS
00085     ENDIF
00086     SELECT CASE(IDATE(2))
00087       CASE(4,6,9,11)
00088         IDATE(3) = IDATE(3) + 30
00089       CASE(1,3,5,7:8,10,12)
00090         IDATE(3) = IDATE(3) + 31
00091       CASE(2)
00092         IF( ((MOD(IDATE(1),4)==0).AND.(MOD(IDATE(1),100)/=0)) .OR. (MOD(IDATE(1),400)==0))THEN
00093           IDATE(3) = IDATE(3) + 29
00094         ELSE
00095           IDATE(3) = IDATE(3) + 28
00096         ENDIF
00097     END SELECT
00098   ENDIF
00099 ENDIF
00100 
00101  CALL WRITE_TIME(IDATE(1),1,"-",HDATE)
00102  CALL WRITE_TIME(IDATE(2),0,"-",HDATE)
00103  CALL WRITE_TIME(IDATE(3),0,"",HDATE)
00104  CALL WRITE_TIME(ITIME(1),1,":",HDATE)
00105  CALL WRITE_TIME(ITIME(2),0,":",HDATE)
00106  CALL WRITE_TIME(ITIME(3),0,"",HDATE)
00107 
00108 IF (LHOOK) CALL DR_HOOK('GET_DATE_OL',1,ZHOOK_HANDLE)
00109 CONTAINS
00110 
00111 
00112 SUBROUTINE WRITE_TIME(ITIME,ISPACE,HSEP,HTDATE)
00113 !
00114 INTEGER, INTENT(IN)             :: ITIME
00115 INTEGER, INTENT(IN)             :: ISPACE
00116  CHARACTER(LEN=*), INTENT(IN)    :: HSEP
00117  CHARACTER(LEN=*), INTENT(INOUT) :: HTDATE
00118  CHARACTER(LEN=10)               :: YPAS
00119 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00120 !      
00121 !
00122 IF (LHOOK) CALL DR_HOOK('GET_DATE_OL:WRITE_TIME',0,ZHOOK_HANDLE)
00123 IF (ITIME.LT.10) THEN
00124   WRITE(YPAS,'(i1)') ITIME
00125   IF (ISPACE==1) THEN
00126     HTDATE=trim(HTDATE)//" 0"//trim(YPAS)//HSEP
00127   ELSE
00128     HTDATE=trim(HTDATE)//"0"//trim(YPAS)//HSEP
00129   ENDIF
00130 ELSE
00131   IF (ITIME.LT.100) THEN
00132     WRITE(YPAS,'(i2)') ITIME
00133   ELSE
00134     WRITE(YPAS,'(i4)') ITIME
00135   ENDIF
00136   IF (ISPACE==1) THEN
00137     HTDATE=trim(HTDATE)//" "//trim(YPAS)//HSEP
00138   ELSE
00139     HTDATE=trim(HTDATE)//trim(YPAS)//HSEP
00140   ENDIF  
00141 ENDIF
00142 IF (LHOOK) CALL DR_HOOK('GET_DATE_OL:WRITE_TIME',1,ZHOOK_HANDLE)
00143 !
00144 !
00145 END SUBROUTINE WRITE_TIME
00146 
00147 
00148 END SUBROUTINE GET_DATE_OL