def_var_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 def_var_netcdf (HSELECT, &
                                 KFILE_ID, HNAME, HLONG_NAME, KDIM_ID, HATT_TITLE, HATT_TEXT,&
                                 KVAR_ID, KTYPE, KLEN, HATT_TITLE2, PATT_FLOAT,&
                                 HATT_TITLE3, PATT_FLOAT2D)
!
!!
!!    MODIFICATIONS
!!    -------------
!!      B. Decharme 07/2013 special case for time in netcdf output files
!-------------------------------------------------------------------------------
!
USE modd_io_surf_nc, ONLY : cfileout_nc, nid_nc
USE modd_surf_par,       ONLY : xundef, nundef
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE

!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
INTEGER,               INTENT(IN) :: KFILE_ID
 CHARACTER(LEN=*),      INTENT(IN) :: HNAME
 CHARACTER(LEN=*),      INTENT(IN) :: HLONG_NAME
INTEGER, DIMENSION(:), INTENT(IN) :: KDIM_ID
 CHARACTER(LEN=*),DIMENSION(:),OPTIONAL, INTENT(IN) :: HATT_TITLE,HATT_TEXT
INTEGER, OPTIONAL, INTENT(OUT) :: KVAR_ID
INTEGER, OPTIONAL, INTENT(IN) :: KTYPE
INTEGER, OPTIONAL, INTENT(IN) :: KLEN
 CHARACTER(LEN=*),DIMENSION(:),OPTIONAL, INTENT(IN) :: HATT_TITLE2
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PATT_FLOAT
 CHARACTER(LEN=*),DIMENSION(:),OPTIONAL, INTENT(IN) :: HATT_TITLE3
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PATT_FLOAT2D
!
! ** local variables
!
 CHARACTER(LEN=100) :: YNAME
 CHARACTER(LEN=50) :: YPAS
INTEGER, DIMENSION(4) :: IRET
INTEGER :: JRET,IVAR_ID,IATT,JATT,ILEN,INDIM
INTEGER :: IFIELD,JFIELD,ISIZE
LOGICAL :: NOWRITE, GOPENED, GEXIST
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!--------------------------------------
!
IF (lhook) CALL dr_hook('DEF_VAR_NETCDF',0,zhook_handle)
!
! if output fields selection is active, test if this field is to be written
IF ( hname/='xx'  .AND. hname/='yy' .AND. hname/='lon' .AND. &
     hname/='lat' .AND. hname/='time' .AND. hname/='Projection_Type' .AND. &
     hname/='longitude' .AND. hname/='latitude' .AND. SIZE(hselect)>0 )  THEN
  ifield=count(hselect /= '            ')
  nowrite=.true.
  DO jfield=1,ifield
    IF ( trim(hselect(jfield))==trim(hname) ) THEN
      nowrite=.false.
    ENDIF
  ENDDO
  IF ( nowrite  .AND. lhook) CALL dr_hook('DEF_VAR_NETCDF',1,zhook_handle)
  IF ( nowrite ) RETURN
ENDIF
!
!define variables in the netcdf file
indim=SIZE(kdim_id)
!
IF (PRESENT(ktype)) THEN
  iret(1) = nf90_def_var(kfile_id,hname,ktype,kdim_id,ivar_id)
ELSE
  iret(1) = nf90_def_var(kfile_id,hname,nf90_double,kdim_id,ivar_id)
ENDIF
!
IF (indim/=0) THEN
  IF (PRESENT(ktype)) THEN
    IF (ktype==nf90_double .OR. ktype==nf90_float) THEN
      iret(2) = nf90_put_att(kfile_id,ivar_id,'_FillValue',xundef)
    ELSEIF (ktype==nf90_int .OR. ktype==nf90_short) THEN
      iret(2) = nf90_put_att(kfile_id,ivar_id,'_FillValue',nundef)
    ELSEIF (ktype==nf90_char) THEN
      IF (indim>1) iret(2) = nf90_put_att(kfile_id,ivar_id,'_FillValue',"")
    ENDIF
  ELSE
    iret(2) = nf90_put_att(kfile_id,ivar_id,'_FillValue',xundef)
  ENDIF
ENDIF
!
IF (PRESENT(ktype)) THEN
  IF (ktype==nf90_char) THEN
    IF (PRESENT(klen)) iret(3) = nf90_put_att(kfile_id,ivar_id,'len',klen)
  ENDIF
ENDIF
!
IF (hlong_name.NE.'') iret(2) = nf90_put_att(kfile_id,ivar_id,'long_name',hlong_name)
!
!Write optional attribute
IF (PRESENT(hatt_title).AND.PRESENT(hatt_text)) THEN  
  iatt=SIZE(hatt_title)
  IF (iatt .EQ. SIZE(hatt_text)) THEN
    DO jatt=1,iatt
      ilen=len_trim(hatt_text(jatt))
      ypas=hatt_text(jatt)
      jret = nf90_put_att(kfile_id,ivar_id,hatt_title(jatt),hatt_text(jatt))
    ENDDO
  ENDIF
ENDIF
!
!Write optional attribute
IF (PRESENT(hatt_title2).AND.PRESENT(patt_float)) THEN  
  iatt=SIZE(hatt_title2)
  IF (iatt .EQ. SIZE(patt_float)) THEN
    DO jatt=1,iatt
      ilen=len_trim(hatt_title2(jatt))
      ypas=hatt_title2(jatt)
      jret = nf90_put_att(kfile_id,ivar_id,hatt_title2(jatt),patt_float(jatt))
    ENDDO
  ENDIF
ENDIF
!
!Write optional attribute
IF (PRESENT(hatt_title3).AND.PRESENT(patt_float2d)) THEN  
  iatt=SIZE(hatt_title3)
  IF (iatt .EQ. SIZE(patt_float2d,1)) THEN
    DO jatt=1,iatt
      ilen=len_trim(hatt_title3(jatt))
      ypas=hatt_title3(jatt)
      jret = nf90_put_att(kfile_id,ivar_id,hatt_title3(jatt),patt_float2d(jatt,:))
    ENDDO
  ENDIF
ENDIF
!
IF (PRESENT(kvar_id)) kvar_id = ivar_id
!
IF (lhook) CALL dr_hook('DEF_VAR_NETCDF',1,zhook_handle)
!
END SUBROUTINE def_var_netcdf