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 (HSELECT, HFILE, KFILE_ID, KDDIM, HATT_TITLE, HNAME_DIM, &
                          HUNIT1, HUNIT2, KDIM1, HDATE, PX, PY, PLON, PLAT)
!
USE modd_diag_n, ONLY : diag_t
!
USE modn_io_offline,  ONLY : lwrite_coord
!
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
 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
REAL,DIMENSION(:), OPTIONAL, INTENT(IN)    :: PLON, PLAT
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZLAT, ZLON
 CHARACTER(LEN=100) :: YNAME1, YNAME2
INTEGER, DIMENSION(:), ALLOCATABLE :: ITEMP
INTEGER :: IVAR_ID, JRET, IDIM2, JJ
INTEGER :: INDIMS, ID1, ID2, ID3, ID4
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('OL_WRITE_COORD',0,zhook_handle)
!
yname1 = "longitude"
yname2 = "latitude"
IF (PRESENT(plat).AND.PRESENT(plon)) THEN
  ALLOCATE(zlat(SIZE(plat),1),zlon(SIZE(plon),1))
  zlat(:,1) = plat(:)
  zlon(:,1) = plon(:)
ELSE
  ALLOCATE(zlat(0,0),zlon(0,0))
ENDIF
!
id1 = 0
id2 = 0
IF ( lwrite_coord ) THEN
  !
  IF (SIZE(zlat)>0) THEN
    CALL def_var_netcdf(hselect,kfile_id,trim(yname1),'',kddim(1:1),(/'units'/),(/'degree'/),kvar_id=id3)
    CALL def_var_netcdf(hselect,kfile_id,trim(yname2),'',kddim(1:1),(/'units'/),(/'degree'/),kvar_id=id4)
  ELSE  
    CALL def_var_netcdf(hselect,kfile_id,trim(hname_dim(2)),'',kddim(1:1),hatt_title,hunit1,kvar_id=id1)
    CALL def_var_netcdf(hselect,kfile_id,trim(hname_dim(3)),'',kddim(1:1),hatt_title,hunit2,kvar_id=id2)
  ENDIF
  !
ELSEIF (kdim1.NE.0) THEN
  !
  CALL def_var_netcdf(hselect,kfile_id,trim(hname_dim(1)),'',kddim(1:1),hatt_title,hunit1,kvar_id=id1)
  CALL def_var_netcdf(hselect,kfile_id,trim(hname_dim(2)),'',kddim(2:2),hatt_title,hunit2,kvar_id=id2)
  !
ELSEIF (SIZE(zlat)>0) THEN
  CALL def_var_netcdf(hselect,kfile_id,trim(yname1),'',kddim(1:1),(/'units'/),(/'degree'/),kvar_id=id3)
  CALL def_var_netcdf(hselect,kfile_id,trim(yname2),'',kddim(1:1),(/'units'/),(/'degree'/),kvar_id=id4)
ENDIF
!
indims = SIZE(kddim)
IF (hname_dim(indims)=='time') CALL def_var_netcdf(hselect,kfile_id,'time','',kddim(indims:indims),hatt_title,hdate)
!
jret=nf90_enddef(kfile_id)
!
IF (id1/=0 .AND. id2/=0) THEN
  jret = nf90_put_var(kfile_id, id1, px)
  jret = nf90_put_var(kfile_id, id2, py)
ENDIF
!
IF (SIZE(zlat)>0) THEN
  jret = nf90_put_var(kfile_id, id3, zlon)
  jret = nf90_put_var(kfile_id, id4, zlat)
ENDIF
!
DEALLOCATE(zlat,zlon)
!
IF (lhook) CALL dr_hook('OL_WRITE_COORD',1,zhook_handle)
!
END SUBROUTINE ol_write_coord