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 (UG, U, 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_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_sso_n, ONLY : sso_t
!
USE modi_abor1_sfx

USE modi_read_and_send_mpi
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
!
USE netcdf
!
IMPLICIT NONE

!
!*      0.1    declarations of arguments
!
!
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(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
!
REAL, DIMENSION(:), ALLOCATABLE :: ZFIELD0
!
!*      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=nf90_open(hfilename,nf90_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=nf90_close(id_file)

IF (PRESENT(pfield)) THEN

  ALLOCATE(zfield0(u%NDIM_FULL))
  !
  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

    zfield0(jpoint)=zfield(jpoint)

!    END IF
  END DO
  !
  CALL read_and_send_mpi(zfield0,pfield)
  !
  DEALLOCATE(zfield0)
  !
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(ug, u, 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

USE netcdf
!
IMPLICIT NONE


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=nf90_inq_varid(id_file,trim(hfield),id_var)
 CALL handle_err_cdf(ierror,"can't find variable "//trim(hfield))

! 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")


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('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=nf90_inquire_variable(id_file,id_var,xtype=itype)
IF (itype/=nf90_double) THEN
  CALL abor1_sfx('READ_PGD_NETCDF: incorrect type for variable '//trim(hfield))
END IF

! Read 1D variable
ierror=nf90_get_var(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