read_surf_atm_date.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 read_surf_atm_date (&
                                     hprogram,hinit,kluout,            &
                                      hatmfile,hatmfiletype,            &
                                      kyear,kmonth,kday,ptime,tptime    )  
!     #######################################################
!
!!****  *READ_SURF_ATM_DATE* - routine to initialise the date TPTIME
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      S.Malardel   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004 
!!      P. Le Moigne 10/2005, Phasage Arome
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
USE modd_type_date_surf
USE modd_surf_par,       ONLY : xundef, nundef
!
USE modi_read_pre_surfa_dat_conf
USE modi_read_prep_surf_atm_conf
USE modi_read_prep_file_date
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram    ! program calling ISBA
 CHARACTER(LEN=3),  INTENT(IN)  :: hinit       ! fields to initialize 'ALL', 'PRE', 'PGD'
TYPE (date_time),  INTENT(OUT) :: tptime      ! time and date
INTEGER,           INTENT(IN)  :: kluout      ! logical unit of output listing
 CHARACTER(LEN=28), INTENT(IN)  :: hatmfile    ! atmospheric file name
 CHARACTER(LEN=6),  INTENT(IN)  :: hatmfiletype! atmospheric file type
INTEGER,           INTENT(IN)  :: kyear       ! current year (UTC)
INTEGER,           INTENT(IN)  :: kmonth      ! current month (UTC)
INTEGER,           INTENT(IN)  :: kday        ! current day (UTC)
REAL,              INTENT(IN)  :: ptime       ! current time since midnight (UTC, s)
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
 CHARACTER(LEN=28)              :: yfile       ! file name
 CHARACTER(LEN=6)               :: yfiletype   ! file type
 CHARACTER(LEN=28)              :: yfilepgd       ! file name
 CHARACTER(LEN=6)               :: yfilepgdtype   ! file type
 CHARACTER(LEN=28)              :: yfilepgdin       ! file name
 CHARACTER(LEN=6)               :: yfilepgdintype   ! file type
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('READ_SURF_ATM_DATE',0,zhook_handle)
yfile     = '                         '
yfiletype = '      '
!
yfilepgdin     = '                         '
yfilepgdintype = '      '
!
!-------------------------------------------------------------------------------
!
!* look for a date in the namelist NAM_SURF_ATM
!----------------------------------------------
!
 CALL read_pre_surfa_dat_conf(hprogram,kluout,tptime)
!
!* If no date in the namelist, look for a file
!  ---------------
!
IF (tptime%TDATE%YEAR==nundef.OR.tptime%TDATE%MONTH==nundef &
      .OR.tptime%TDATE%DAY==nundef.OR.tptime%TIME==xundef) THEN  
!
  CALL read_prep_surf_atm_conf(hprogram,yfile,yfiletype,yfilepgd,yfilepgdtype,&
                               hatmfile,hatmfiletype,yfilepgdin,yfilepgdintype,kluout)
!
  IF (len_trim(yfiletype)/=0) &
    CALL read_prep_file_date(&
                             hprogram,yfile,yfiletype,tptime,kluout)  
END IF
!
!* If no file and no date in the namelist, test if atmospheric date
!------------------------------------------------------------------
!
IF (len_trim(yfile)==0 .AND. (tptime%TDATE%YEAR==xundef.OR.tptime%TDATE%MONTH==xundef &
                               .OR.tptime%TDATE%DAY==xundef.OR.tptime%TIME==xundef)) THEN  
!
  IF (kyear /= nundef .AND. kmonth /= nundef .AND. kday /= nundef .AND. ptime /= xundef) THEN
    tptime%TDATE%YEAR = kyear
    tptime%TDATE%MONTH= kmonth
    tptime%TDATE%DAY  = kday
    tptime%TIME = ptime
  ELSE
!
!* If no file, no date in the namelist and no atmospheric date : stop
!-----------------------------------------------------------------------
!
    CALL abor1_sfx('READ_SURF_ATM_DATE: DATE NOT SET')
  END IF
END IF
!
!* Test of date coherence?
!------------------------ 
!
IF (kyear /= nundef .AND. kmonth /= nundef .AND. kday /= nundef .AND. ptime /= xundef) THEN
  IF (kyear /= tptime%TDATE%YEAR .OR. kmonth /= tptime%TDATE%MONTH &
         .OR. kday /= tptime%TDATE%DAY .AND. ptime /= tptime%TIME) THEN  
    WRITE(unit=kluout, fmt=*) 'WARNING in READ_SURF_ATM_DATE'
    WRITE(unit=kluout, fmt=*) 'ATMOSPHERIC AND SURFACE DATES ARE NOT THE SAME'

    WRITE(unit=kluout, fmt=*)'ATMOSPHERIC DATE:'
    WRITE(unit=kluout, fmt='(" YEAR=",I4)') kyear
    WRITE(unit=kluout, fmt='(" MONTH=",I4)') kmonth
    WRITE(unit=kluout, fmt='(" DAY=",I4)') kday
    WRITE(unit=kluout, fmt='(" TIME=",E13.6)') ptime
    WRITE(unit=kluout, fmt=*)'SURFACE DATE:'
    WRITE(unit=kluout, fmt='(" YEAR=",I4)') tptime%TDATE%YEAR
    WRITE(unit=kluout, fmt='(" MONTH=",I4)') tptime%TDATE%MONTH
    WRITE(unit=kluout, fmt='(" DAY=",I4)') tptime%TDATE%DAY
    WRITE(unit=kluout, fmt='(" TIME=",E13.6)') tptime%TIME
  ELSE
    WRITE(unit=kluout, fmt=*)'SAME ATMOSPHERIC AND SURFACE DATES'
    WRITE(unit=kluout, fmt=*)'DATE in READ_SURF_ATM_DATE:'
    WRITE(unit=kluout, fmt='(" YEAR=",I4," MONTH=",I4," DAY=",I4)') &
                                        kyear,kmonth,kday  
    WRITE(unit=kluout, fmt='(" TIME=",E13.6)') ptime
  ENDIF
ENDIF
IF (lhook) CALL dr_hook('READ_SURF_ATM_DATE',1,zhook_handle)
!------------------------------------------------------------------------------
!
END SUBROUTINE read_surf_atm_date