prep_isba_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 prep_isba_netcdf (DTCO, U, HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD)
!     #################################################################################
!
!!****  *PREP_ISBA_NETCDF* - prepares ISBA fields from initialization files in NETCDF
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     M. Lafaysse
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    04/2012
!!      J.Escobar   11/2013  Add USE MODI_GET_TYPE_DIM_n
!!------------------------------------------------------------------
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surf_par, ONLY : xundef
USE modd_surfex_mpi, ONLY : nrank, npio
USE modd_prep,           ONLY : cinterp_type
!
USE modi_abor1_sfx
USE modi_get_type_dim_n
USE modi_read_and_send_mpi
USE modi_gather_and_write_mpi
!
USE mode_read_cdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE

!
!*      0.1    declarations of arguments
!
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(surf_atm_t), INTENT(INOUT) :: U
!
 CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
 CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
 CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file
INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing
REAL,DIMENSION(:,:,:), POINTER    :: PFIELD    ! field to interpolate horizontally
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(:), ALLOCATABLE :: ZNATURE
REAL, DIMENSION(:), ALLOCATABLE :: ZFIELD, ZFIELD0   ! field read

! CHARACTER(LEN=28) :: YNCVAR
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
INTEGER :: JI, ICPT
INTEGER::IERROR !error status
INTEGER::JJ,JK,JLOOP ! loop counters
INTEGER::INLAYERS ! vertical dimension length
INTEGER::IL ! nature dimension length
INTEGER::ID_FILE,ID_VAR ! Netcdf IDs for file and variable
INTEGER::INVARDIMS !number of dimensions of netcdf input variable
INTEGER,DIMENSION(:),ALLOCATABLE::IVARDIMSID
INTEGER::ILENDIM,ILENDIM1,ILENDIM2

SELECT CASE (trim(hsurf))
  CASE ('TG','WG','WGI')
    inlayers=3 ! 3 soil layers for initialization
  CASE DEFAULT
    CALL abor1_sfx('PREP_ISBA_NETCDF: '//trim(hsurf)//" initialization not implemented !")
END SELECT
!
inlayers=3
!
!------------------------------------------------------------------------------------
!              ---------
IF (lhook) CALL dr_hook('PREP_ISBA_NETCDF',0,zhook_handle)

!*      1.    get nature dimension
!
 CALL get_type_dim_n(dtco, u, 'NATURE',il)
!
!*      2.     Reading of field
!              ----------------
!
IF (nrank==npio) THEN
  ! Open netcdf file
  ierror=nf90_open(hfile,nf90_nowrite,id_file)
   CALL handle_err_cdf(ierror,"can't open file "//trim(hfile))
 
  ! Look for variable ID
  ierror=nf90_inq_varid(id_file,trim(hsurf),id_var)
   CALL handle_err_cdf(ierror,"can't find variable "//trim(hsurf))

  ! Number of dimensions
  ierror=nf90_inquire_variable(id_file,id_var,ndims=invardims)
  if (ierror/=nf90_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions number")
  ! Id of dimensions
  ALLOCATE(ivardimsid(invardims))
  ierror=nf90_inquire_variable(id_file,id_var,dimids=ivardimsid)
  if (ierror/=nf90_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions ids")

  ALLOCATE(zfield(u%NDIM_NATURE))

  SELECT CASE (invardims)
    CASE (1)
      ! Check dimension length
      ierror=nf90_inquire_dimension(id_file,ivardimsid(1),len=ilendim)
      if (ierror/=nf90_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions lengths")
    CASE (2)
      ierror=nf90_inquire_dimension(id_file,ivardimsid(1),len=ilendim1)
      if (ierror/=nf90_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions lengths")
      ierror=nf90_inquire_dimension(id_file,ivardimsid(2),len=ilendim2)
      if (ierror/=nf90_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions lengths")
  
      ilendim=ilendim1*ilendim2
  
    CASE DEFAULT
      CALL abor1_sfx('PREP_ISBA_NETCDF: incorrect number of dimensions for variable '//trim(hsurf))
  
  END SELECT
  !
  IF(ilendim/=u%NDIM_NATURE) CALL abor1_sfx('PREP_ISBA_NETCDF: incorrect number of points '// &
                                  'in netcdf file for variable '//trim(hsurf))
  !
  ! Read 1D variable
  ierror=nf90_get_var(id_file,id_var,zfield)
   CALL handle_err_cdf(ierror,"can't read variable "//trim(hsurf))
  !
  ! Close netcdf file
  ierror=nf90_close(id_file)
  !
ELSE
  ALLOCATE(zfield(0))
ENDIF
!
IF (nrank==npio) THEN
  ALLOCATE(znature(u%NDIM_FULL))
ELSE
  ALLOCATE(znature(0))
ENDIF
 CALL gather_and_write_mpi(u%XNATURE,znature)
!
IF (nrank==npio) THEN
  ALLOCATE(zfield0(u%NDIM_FULL))
  zfield0(:) = xundef
  icpt = 0
  DO ji=1,u%NDIM_FULL
    IF (znature(ji)/=0.) THEN
      icpt = icpt + 1
      zfield0(ji) = zfield(icpt)
    ENDIF
  ENDDO
ELSE
  ALLOCATE(zfield0(0))
ENDIF
!
DEALLOCATE(znature,zfield)
ALLOCATE(pfield(il,inlayers,1)) !will be deallocated later by prep_hor_isba_field
!
 CALL read_and_send_mpi(zfield0,pfield(:,1,1),u%NR_NATURE)
!
! For now initial values are identical for all tiles / soil layers.
DO jj=2,inlayers
  pfield(:,jj,1)=pfield(:,1,1)
END DO
!
DEALLOCATE(zfield0)
!
!Interpolation method
cinterp_type='NONE'
!
IF (lhook) CALL dr_hook('PREP_ISBA_NETCDF',1,zhook_handle)
!-------------------------------------------------------------------------------------
END SUBROUTINE prep_isba_netcdf