ol_write_coord.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 ol_write_coord (DGU, &
                           hfile, kfile_id, kddim, hatt_title, hname_dim, &
                          hunit1, hunit2, kdim1, hdate, px, py)
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
!
USE modd_ol_fileid,   ONLY : xid, xout
USE modn_io_offline,  ONLY : lwrite_coord
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
include 'netcdf.inc'
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 CHARACTER(LEN=50),     INTENT(IN) :: hfile
INTEGER,               INTENT(IN) :: kfile_id
INTEGER, DIMENSION(:), INTENT(IN) :: kddim
 CHARACTER(LEN=100), DIMENSION(:), INTENT(IN) :: hatt_title
 CHARACTER(LEN=100), DIMENSION(:), INTENT(IN) :: hname_dim
 CHARACTER(LEN=13) , DIMENSION(:), INTENT(IN) :: hunit1, hunit2
INTEGER, INTENT(IN) :: kdim1
 CHARACTER(LEN=40),DIMENSION(:), INTENT(IN) :: hdate
REAL,DIMENSION(:), INTENT(IN)              :: px, py
!
INTEGER, DIMENSION(:), ALLOCATABLE :: itemp
INTEGER :: ivar_id, jret
INTEGER :: indims
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('OL_WRITE_COORD',0,zhook_handle)
!
IF ( lwrite_coord ) THEN
  CALL def_var_netcdf(dgu, &
                      kfile_id,'xx','abscissas',kddim(1:1),hatt_title,(/''/))
  CALL def_var_netcdf(dgu, &
                      kfile_id,'yy','ordinates',kddim(1:1),hatt_title,(/''/))
ELSEIF (kdim1.NE.0) THEN
  CALL def_var_netcdf(dgu, &
                      kfile_id,trim(hname_dim(1)),'',kddim(1:1),hatt_title,hunit1)
  CALL def_var_netcdf(dgu, &
                      kfile_id,trim(hname_dim(2)),'',kddim(2:2),hatt_title,hunit2)
ENDIF
indims = SIZE(kddim)
 CALL def_var_netcdf(dgu, &
                      kfile_id,'time','',kddim(indims:indims),hatt_title,hdate)
!
jret=nf_enddef(kfile_id)
!
jret=nf_open(hfile, nf_write,kfile_id)
IF (kdim1.NE.0) THEN
  jret = nf_inq_varid(kfile_id, hname_dim(1), ivar_id)
  jret = nf_put_var_double(kfile_id, ivar_id, px)
  jret = nf_inq_varid(kfile_id, hname_dim(2), ivar_id)
  jret = nf_put_var_double(kfile_id, ivar_id, py)
ELSEIF (lwrite_coord) THEN
  jret = nf_inq_varid(kfile_id, 'xx', ivar_id)
  jret = nf_put_var_double(kfile_id, ivar_id, px)
  jret = nf_inq_varid(kfile_id, 'yy', ivar_id)
  jret = nf_put_var_double(kfile_id, ivar_id, py)
ENDIF
!
ALLOCATE(itemp(xout))
itemp(SIZE(xid)+1:xout) = kfile_id
IF (SIZE(xid).GT.0) itemp(1:SIZE(xid))=xid
DEALLOCATE(xid)
ALLOCATE(xid(xout))
xid=itemp
DEALLOCATE(itemp)
!
IF (lhook) CALL dr_hook('OL_WRITE_COORD',1,zhook_handle)
!
END SUBROUTINE ol_write_coord