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 (DGU, &
                                 kfile_id,hname,hlong_name,kdim_id,hatt_title,hatt_text,kvar_id,ktype,klen)
!
!!
!!    MODIFICATIONS
!!    -------------
!!      B. Decharme 07/2013 special case for time in netcdf output files
!-------------------------------------------------------------------------------
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_io_surf_nc, ONLY : cfileout_nc, nid_nc
USE modd_ol_fileid,      ONLY : xvar_to_fileout, xout
USE modd_surf_par,       ONLY : xundef, nundef
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
include "netcdf.inc"

!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
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
!
! ** local variables
!
 CHARACTER(LEN=20), DIMENSION(:), ALLOCATABLE :: ytemp 
 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 (.NOT.ALLOCATED(xvar_to_fileout)) ALLOCATE(xvar_to_fileout(100))
!
xout=xout+1
ALLOCATE(ytemp(xout))
ytemp(xout) = hname
IF (xout.GT.1) ytemp(1:xout-1) = xvar_to_fileout
!
IF(ALLOCATED(xvar_to_fileout)) DEALLOCATE(xvar_to_fileout)
ALLOCATE(xvar_to_fileout(xout))
xvar_to_fileout = ytemp
!
DEALLOCATE(ytemp)
!
! 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. dgu%LSELECT )  THEN
  ifield=count(dgu%CSELECT /= '            ')
  nowrite=.true.
  DO jfield=1,ifield
    IF ( trim(dgu%CSELECT(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) = nf_def_var(kfile_id,hname,ktype,indim,kdim_id,ivar_id)
ELSE
  iret(1) = nf_def_var(kfile_id,hname,nf_double,indim,kdim_id,ivar_id)
ENDIF
!
IF (indim/=0) THEN
  IF (present(ktype)) THEN
    IF (ktype==nf_double .OR. ktype==nf_float) THEN
      iret(2) = nf_put_att_double(kfile_id,ivar_id,'_FillValue',nf_double,1,xundef)
    ELSEIF (ktype==nf_int .OR. ktype==nf_short) THEN
      iret(2) = nf_put_att_int(kfile_id,ivar_id,'_FillValue',nf_int,1,nundef)
    ELSEIF (ktype==nf_char) THEN
      IF (indim>1) iret(2) = nf_put_att_text(kfile_id,ivar_id,'_FillValue',nf_char,1,"")
      IF (present(klen)) iret(3) = nf_put_att_int(kfile_id,ivar_id,'len',nf_int,1,klen)
    ENDIF
  ELSE
    iret(2) = nf_put_att_double(kfile_id,ivar_id,'_FillValue',nf_double,1,xundef)
  ENDIF
ENDIF
!
IF (present(ktype)) THEN
  IF (ktype==nf_char) THEN
    IF (present(klen)) iret(3) = nf_put_att_int(kfile_id,ivar_id,'len',nf_int,1,klen)
  ENDIF
ENDIF
!
IF (hlong_name.NE.'') iret(2) = nf_put_att_text(kfile_id,ivar_id,'long_name',len_trim(hlong_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 = nf_put_att_text(kfile_id,ivar_id,hatt_title(jatt),ilen,hatt_text(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