ol_read_atm_conf_netcdf.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 ol_read_atm_conf_netcdf (YSC, &
                                    hsurf_filetype,                &
                                     pduration, ptstep_forc, kni, &
                                     kyear, kmonth, kday, ptime,  &
                                     plat, plon, pzs,             &
                                     pzref, puref                 )  
!
!==================================================================
!!****  *OL_READ_ATM_CONF* - Initialization routine
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      F. Habets   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      Modified by P. Le Moigne (04/2005): cleaning and checking
!!      Modified by P. Le Moigne (04/2006): init_io_surf for nature
!!                  with GTMSK to read dimensions.
!!      Modified by Matthieu Lafaysse 2012-11-12
!==================================================================
!
!
USE modd_surfex_n, ONLY : surfex_t
!
USE modd_type_date_surf
!
USE modd_surfex_mpi, ONLY : nrank, npio, ncomm, nproc, xtime_comm_read, xtime_npio_read
!
USE modi_set_surfex_filein
USE modi_get_luout
USE modi_init_io_surf_n
USE modi_read_surf
USE modi_end_io_surf_n
USE modi_get_size_full_n
USE modi_abor1_sfx
!
USE mode_dates_netcdf, ONLY : netcdf2date
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
TYPE(surfex_t), INTENT(INOUT) :: ysc
!
 CHARACTER(LEN=6), INTENT(IN)  :: hsurf_filetype
INTEGER,          INTENT(OUT) :: kni
INTEGER,          INTENT(OUT) :: kyear, kmonth, kday
REAL,             INTENT(OUT) :: pduration,ptstep_forc
REAL,             INTENT(OUT) :: ptime
REAL, DIMENSION(:),  POINTER  :: plat, plon
REAL, DIMENSION(:),  POINTER  :: pzs 
REAL, DIMENSION(:),  POINTER  :: pzref, puref
!
 CHARACTER(LEN=100)            :: yunits
REAL                          :: ztime
REAL                          :: zfirsttimefile
INTEGER                       :: iyear, imonth, iday
INTEGER                       :: iret, inb_forc
INTEGER                       :: ini, idim_full
INTEGER                       :: iluout
INTEGER                       :: infompi
TYPE (date_time)              :: ttime
TYPE (date_time) ,DIMENSION(1):: tz_firstdatefile
DOUBLE PRECISION   :: xtime0
REAL(KIND=JPRB) :: zhook_handle
!
!==================================================================
!
!*      0.    IO initialization
!
IF (lhook) CALL dr_hook('OL_READ_ATM_CONF_NETCDF',0,zhook_handle)
!
IF (nrank==npio) THEN
  !
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
#endif
  !
  CALL get_luout(hsurf_filetype,iluout)
  !
  !*      1.    Read parameters from netcdf forcing file
  !
  yunits = ""
  CALL read_surf_dim_ol(yunits, inb_forc, ini, zfirsttimefile, iret)
  !
#ifdef SFX_MPI
  xtime_npio_read = xtime_npio_read + (mpi_wtime() - xtime0)
#endif
  !
ENDIF
!
IF (nproc>1) THEN
#ifdef SFX_MPI
  xtime0 = mpi_wtime()
  CALL mpi_bcast(inb_forc,kind(inb_forc)/4,mpi_integer,npio,ncomm,infompi)
  xtime_comm_read = xtime_comm_read + (mpi_wtime() - xtime0)
#endif
ENDIF
!
 CALL read_surf(&
                'OFFLIN','FRC_TIME_STP'  ,ptstep_forc   ,iret)
!
pduration = ( inb_forc - 1 ) * ptstep_forc
!
!*      2.    Read full grid dimension and date
!
 CALL set_surfex_filein(hsurf_filetype,'PREP')
 CALL init_io_surf_n(ysc%DTCO, ysc%DGU, ysc%U, &
                      hsurf_filetype,'FULL  ','SURF  ','READ ')  
!
 CALL read_surf(&
                hsurf_filetype,'DIM_FULL',idim_full,iret)
 CALL read_surf(&
                hsurf_filetype,'DTCUR',ttime,iret)
!
kyear  = ttime%TDATE%YEAR
kmonth = ttime%TDATE%MONTH
kday   = ttime%TDATE%DAY
ptime  = ttime%TIME
!
 CALL end_io_surf_n(hsurf_filetype)
!
!*      5.    Geographical initialization
!
 CALL get_size_full_n(ysc%U, &
                      'OFFLIN ',idim_full,kni) 
!
ALLOCATE(plon(kni))
ALLOCATE(plat(kni))
ALLOCATE(pzs(kni))
ALLOCATE(pzref(kni))
ALLOCATE(puref(kni))
!
 CALL read_surf(&
                'OFFLIN','LAT',plat,iret)
 CALL read_surf(&
                'OFFLIN','LON',plon,iret)
 CALL read_surf(&
                'OFFLIN','ZS',pzs,iret)
 CALL read_surf(&
                'OFFLIN','ZREF',pzref,iret)
 CALL read_surf(&
                'OFFLIN','UREF',puref,iret)
!
!*      6.    Check the consistency
!
IF (nrank == npio) THEN
  !
  IF (idim_full /= ini) THEN
    WRITE(iluout,*)' NUMBER OF GRID POINTS INCONSISTENCY: ',kni,'/',ini
    CALL abor1_sfx('OL_READ_ATM_CONF_NETCDF: NUMBER OF GRID POINTS INCONSISTENCY')
  ENDIF
  !
  CALL netcdf2date((/zfirsttimefile/),yunits,tz_firstdatefile)
  iyear  = tz_firstdatefile(1)%TDATE%YEAR
  imonth = tz_firstdatefile(1)%TDATE%MONTH
  iday   = tz_firstdatefile(1)%TDATE%DAY
  ztime  = tz_firstdatefile(1)%TIME* 3600.
  !
  IF ( (kyear /= iyear) .OR. (kmonth /= imonth) .OR. (kday /= iday) ) THEN
    WRITE(iluout,*)' DATE INCONSISTENCY: ',kyear,kmonth,kday,'/',iyear,imonth,iday
    CALL abor1_sfx('OL_READ_ATM_CONF_NETCDF: DATE INCONSISTENCY')
  ENDIF
  !
  IF ( ptime /= ztime ) THEN
    WRITE(iluout,*)' TIME INCONSISTENCY: ',ptime,'/',ztime
    CALL abor1_sfx('OL_READ_ATM_CONF_NETCDF: TIME INCONSISTENCY')
  ENDIF
  !
ENDIF
!
IF (lhook) CALL dr_hook('OL_READ_ATM_CONF_NETCDF',1,zhook_handle)
!==================================================================
 CONTAINS
!
!     #############################################################
      SUBROUTINE read_surf_dim_ol(HUNITS,KSIZE,KNI,PFIRSTTIMEFILE,KRESP)
!     #############################################################
!
USE modi_ol_find_file_read
!
IMPLICIT NONE
include "netcdf.inc"
!
!*      0.1   Declarations of arguments
!
 CHARACTER(LEN=100), INTENT(OUT) :: hunits
INTEGER,            INTENT(OUT) :: ksize
INTEGER,            INTENT(OUT) :: kni
REAL,               INTENT(OUT) :: pfirsttimefile
INTEGER,            INTENT(OUT) :: kresp    
!
!*      0.2   Declarations of local variables
!
INTEGER :: ifile_id,ivar_id,indims,jret,jdim,itype
INTEGER,DIMENSION(2) :: idimids,idimlen
INTEGER,DIMENSION(7) :: iret

REAL*4,DIMENSION(:),ALLOCATABLE :: ztimefile4
REAL,DIMENSION(:),ALLOCATABLE :: ztimefile
INTEGER, DIMENSION(:), ALLOCATABLE :: itimefile
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------

IF (lhook) CALL dr_hook('OL_READ_ATM_CONF_NETCDF:READ_SURF_DIM_OL',0,zhook_handle)
kresp=0

! 0. find filename
! -----------------
 CALL ol_find_file_read('time',ifile_id)
 
IF (ifile_id.NE.0) THEN
    
  ! 1. Find id of the variable
  !----------------------------
  iret(1)=nf_inq_varid(ifile_id,'time',ivar_id)
  iret(2)=nf_inq_varndims(ifile_id,ivar_id,indims)
  iret(3)=nf_inq_vardimid(ifile_id,ivar_id,idimids(1:1))
  iret(4)=nf_inq_dimlen(ifile_id,idimids(1),ksize)
  iret(5)=nf_get_att_text(ifile_id,ivar_id,'units',hunits)

  iret(6)=nf_inq_vartype(ifile_id,ivar_id,itype)

  SELECT CASE (itype)
    CASE (nf_double)
      ALLOCATE(ztimefile(ksize))
      iret(7)=nf_get_var_double(ifile_id,ivar_id,ztimefile)
      pfirsttimefile=ztimefile(1)
      DEALLOCATE(ztimefile)
    CASE (nf_float)
      ALLOCATE(ztimefile4(ksize))
      iret(7)=REAL(nf_get_var_real(ifile_id,ivar_id,ztimefile4))
      pfirsttimefile=ztimefile4(1)
      DEALLOCATE(ztimefile4)
    CASE (nf_int)
      ALLOCATE(itimefile(ksize))
      iret(7)=REAL(nf_get_var_int(ifile_id,ivar_id,itimefile))
      pfirsttimefile=itimefile(1)
      DEALLOCATE(itimefile)
    CASE default
      CALL abor1_sfx('OL_READ_ATM_CONF_NETCDF: TYPE OF TIME VARIABLE NOT KNOWN')
  END SELECT
  
  ! 3. Check for errors
  !--------------------
  DO jret=1,7
    IF (ifile_id==0.OR.iret(jret).NE.nf_noerr) kresp=1
  ENDDO

ENDIF

 CALL ol_find_file_read('LON',ifile_id)

IF (ifile_id.NE.0) THEN

  iret(1)=nf_inq_varid(ifile_id,'LON',ivar_id)
  iret(2)=nf_inq_varndims(ifile_id,ivar_id,indims)
  iret(3)=nf_inq_vardimid(ifile_id,ivar_id,idimids(:))
  idimlen(:)=1.
  DO jdim=1,indims
    iret(4)=nf_inq_dimlen(ifile_id,idimids(jdim),idimlen(jdim))
  ENDDO
  kni = idimlen(1) * idimlen(2)

  DO jret=1,4
    IF (ifile_id==0.OR.iret(jret).NE.nf_noerr) kresp=1
  ENDDO

ENDIF
!
IF (lhook) CALL dr_hook('OL_READ_ATM_CONF_NETCDF:READ_SURF_DIM_OL',1,zhook_handle)
!-------------------------------------------------------------------------------
END SUBROUTINE read_surf_dim_ol
!
END SUBROUTINE ol_read_atm_conf_netcdf