read_pgd_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 read_pgd_netcdf (USS, &
                            hprogram,hscheme,hsubroutine,hfilename,hfield,pfield)
!#################################################################################
!
!!****  *READ_PGD_NETCDF* - read data from NETCDF files during PGD (altitude)
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     M. Lafaysse 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    11/2012
!!------------------------------------------------------------------
!

!
!
USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
!
USE modi_abor1_sfx

USE mode_read_cdf, ONLY :handle_err_cdf
! USE MODD_PGD_GRID,       ONLY : NL ! grid dimension length
USE modi_pt_by_pt_treatment
USE modi_get_luout

USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE

include 'netcdf.inc'
!
!*      0.1    declarations of arguments
!

!
TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
!
 CHARACTER(LEN=6),  INTENT(IN) :: hprogram      ! Type of program
 CHARACTER(LEN=6),  INTENT(IN) :: hscheme       ! Scheme treated
 CHARACTER(LEN=6),  INTENT(IN) :: hsubroutine   ! Name of the subroutine to call
 CHARACTER(LEN=28), INTENT(IN) :: hfilename     ! Name of the field file.
 CHARACTER(LEN=20),   INTENT(IN)  :: hfield     ! name of variable
REAL,DIMENSION(:),INTENT(OUT),OPTIONAL :: pfield ! output a variable

REAL,DIMENSION(:),POINTER  :: zlat,zlon
REAL,DIMENSION(:),POINTER  :: zlat2d,zlon2d
REAL,DIMENSION(:),POINTER,SAVE    :: zfield    ! field to read
!
!*      0.2    declarations of local variables
!
! CHARACTER(LEN=28) :: YNCVAR
!
INTEGER::ierror !error status
INTEGER::id_file ! id of netcdf file
INTEGER::infield,inlat,inlon ! dimension lengths
INTEGER::iluout
INTEGER::jpoint !loop counter
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('READ_PGD_NETCDF',0,zhook_handle)
!
 CALL get_luout(hprogram,iluout)
!
SELECT CASE (trim(hfield))
  CASE ('ZS','slope')
  CASE default
    CALL abor1_sfx('READ_PGD_NETCDF: '//trim(hfield)//" initialization not implemented !")
END SELECT

!------------------------------------------------------------------------------------
!              ---------

!
!*      2.     Reading of field
!              ----------------

! Open netcdf file
ierror=nf_open(hfilename,nf_nowrite,id_file)
 CALL handle_err_cdf(ierror,"can't open file "//trim(hfilename))

 CALL read_field_netcdf(id_file,'LAT                 ',zlat,inlat)
 CALL read_field_netcdf(id_file,'LON                 ',zlon,inlon)
 CALL read_field_netcdf(id_file,hfield,zfield,infield)

! Close netcdf file
ierror=nf_close(id_file)

IF (present(pfield)) THEN

  DO jpoint=1,infield

! On pourrait faire un controle des coordonnées ?
!    IF ((ABS(ZLAT(JPOINT)-????XLAT???)<0.001)  .AND. (ABS(ZLON(JPOINT)-????XLON???)<0.001)) THEN

    pfield(jpoint)=zfield(jpoint)

!    END IF
  END DO

ELSE

  ALLOCATE(zlat2d(infield))
  ALLOCATE(zlon2d(infield))

  IF (inlat*inlon==infield) THEN
    CALL abor1_sfx('READ_PGD_NETCDF: 1D LAT and LON not implemented')
  ELSEIF ((inlat==infield) .AND. (infield==inlon)) THEN
    zlat2d(:)=zlat(:)
    zlon2d(:)=zlon(:)
  ELSE
    CALL abor1_sfx('READ_PGD_NETCDF: problem with dimensions lengths between LAT LON and FIELD')
  END IF

  DO jpoint=1,infield
    !*    5.     Call to the adequate subroutine (point by point treatment)
    !            ----------------------------------------------------------
    !     
    CALL pt_by_pt_treatment(uss, &
                            iluout,  (/ zlat2d(jpoint)/) , (/zlon2d(jpoint)/) , (/ zfield(jpoint)/) , &
      hsubroutine                                       )  

  ENDDO

  DEALLOCATE(zlat2d)
  DEALLOCATE(zlon2d)

END IF

DEALLOCATE(zlat)
DEALLOCATE(zlon)

DEALLOCATE(zfield)

IF (lhook) CALL dr_hook('READ_PGD_NETCDF',1,zhook_handle)
!-------------------------------------------------------------------------------------

 CONTAINS

SUBROUTINE read_field_netcdf(ID_FILE,HFIELD,PFIELD,ILENDIM)

USE mode_read_cdf, ONLY :handle_err_cdf

IMPLICIT NONE

include 'netcdf.inc'

INTEGER,INTENT(IN)::id_file
 CHARACTER(LEN=20),   INTENT(IN)  :: hfield     ! name of variable
REAL,DIMENSION(:),POINTER::pfield

INTEGER::id_var ! Netcdf IDs for file and variable
INTEGER::invardims !number of dimensions of netcdf input variable
INTEGER,DIMENSION(:),ALLOCATABLE::ivardimsid
INTEGER::ilendim1,ilendim2
INTEGER,INTENT(OUT)::ilendim
INTEGER::ierror !error status
INTEGER::itype

! Look for variable ID for HFIELD
ierror=nf_inq_varid(id_file,trim(hfield),id_var)
 CALL handle_err_cdf(ierror,"can't find variable "//trim(hfield))

! Number of dimensions
ierror=nf_inq_varndims(id_file,id_var,invardims)
if (ierror/=nf_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions number")

! Id of dimensions
ALLOCATE(ivardimsid(invardims))

ierror=nf_inq_vardimid(id_file,id_var,ivardimsid)
if (ierror/=nf_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions ids")


SELECT CASE (invardims)
  CASE (1)
    ! Check dimension length
    ierror=nf_inq_dimlen(id_file,ivardimsid(1),ilendim)
    if (ierror/=nf_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions lengths")

  CASE (2)
    ierror=nf_inq_dimlen(id_file,ivardimsid(1),ilendim1)
    if (ierror/=nf_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions lengths")
    ierror=nf_inq_dimlen(id_file,ivardimsid(2),ilendim2)
    if (ierror/=nf_noerr) CALL handle_err_cdf(ierror,"can't get variable dimensions lengths")

    ilendim=ilendim1*ilendim2

  CASE default
    CALL abor1_sfx('READ_PGD_NETCDF: incorrect number of dimensions for variable '//trim(hfield))

END SELECT

DEALLOCATE(ivardimsid)

! IF(ILENDIM/=NL) CALL ABOR1_SFX('READ_PGD_NETCDF: incorrect number of points &
! &                             in netcdf file for variable '//TRIM(HFIELD))

ALLOCATE(pfield(ilendim))

ierror=nf_inq_vartype(id_file,id_var,itype)
IF (itype/=nf_double) THEN
  CALL abor1_sfx('READ_PGD_NETCDF: incorrect type for variable '//trim(hfield))
END IF

! Read 1D variable
ierror=nf_get_var_double(id_file,id_var,pfield)

 CALL handle_err_cdf(ierror,"can't read variable "//trim(hfield))

END SUBROUTINE read_field_netcdf


END SUBROUTINE read_pgd_netcdf