ncutils.F90

Go to the documentation of this file.

! (C) Copyright 2017-2018 UCAR
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. 

!> Fortran module to handle temperature profile observations

module ufo_marine_ncutils

  use ncd_kinds
  
  implicit none
  private

  ! General type definition for marine obs
  type, public :: simple_marine_obs
     integer      :: station_id
     real(r_kind) :: observation_type
     real(r_kind) :: latitude
     real(r_kind) :: longitude
     real(r_kind) :: depth
     real(r_kind) :: time
     real(r_kind) :: observation
     real(r_kind) :: observation_error     
     real(r_kind) :: obs_minus_forecast
  end type simple_marine_obs

  type, public :: diag_marine_obs
     integer                              :: nobs           !< Number of obs
     character(len=120)                   :: filename       !< Netcdf output filename
     logical                              :: append=.false. !< If file exist, append to it
     type(simple_marine_obs), allocatable :: diag(:)        !< Data type to hold obs space diagnostics
   contains
     procedure :: init
     procedure :: write_diag
     procedure :: write_geoval     
     procedure :: finalize
  end type diag_marine_obs
  
contains

  ! ------------------------------------------------------------------------------

  subroutine init(self, nobs, filename)

    implicit none

    class(diag_marine_obs) ,intent(out) :: self     !< Obs space diagnostics
    integer                 ,intent(in) :: nobs     !< Number of obs    
    character(len=120)      ,intent(in) :: filename !< Filename for netcdf output
    
    self%nobs=nobs
    self%filename=filename
    allocate(self%diag(nobs))
    
  end subroutine init

  ! ------------------------------------------------------------------------------

  subroutine finalize(self)

    implicit none

    class(diag_marine_obs), intent(inout) :: self  !< Obs space diagnostics

    self%nobs=0
    self%filename=''
    deallocate(self%diag)
    
  end subroutine finalize

  ! ------------------------------------------------------------------------------

  subroutine write_diag(self)

    use netcdf
    use ufo_vars_mod

    implicit none

    class(diag_marine_obs), intent(inout) :: self  !< Obs space diagnostics

    !netcdf stuff
    integer(kind=4) :: iNcid,i,iStationNo
    integer(kind=4) :: iDimStation_ID,iDimTime_ID,iDimLenStringName_ID, iDimLev_ID
    integer(kind=4) :: iVarLON_ID, iVarLAT_ID, iVarLev_ID, iVarObs_ID
    integer(kind=4) :: iVarOMF_ID, iVarOMA_ID, iVarSIGO_ID, iVarOBSID_ID

    integer, allocatable :: obsid(:)
    integer :: nlev,nobs,iobs

    ! Create file.
    call check(nf90_create(self%filename, nf90_clobber, incid))
    call check(nf90_def_dim(incid, "nobs", nf90_unlimited, idimstation_id))
    nobs = self%nobs    

    ! Define of variables.
    call check( nf90_def_var(incid, "OBSID", nf90_int, (/ idimstation_id /), ivarobsid_id) )
    call check( nf90_def_var(incid, "lon", nf90_real, (/ idimstation_id /), ivarlon_id) )
    call check( nf90_def_var(incid, "lat", nf90_real, (/ idimstation_id /), ivarlat_id) )
    call check( nf90_def_var(incid, "lev", nf90_real, (/ idimstation_id /), ivarlev_id) )
    call check( nf90_def_var(incid, "obs", nf90_real, (/ idimstation_id /), ivarobs_id) )
    call check( nf90_def_var(incid, "sigo", nf90_real, (/ idimstation_id /), ivarsigo_id) )
    call check( nf90_def_var(incid, "omf", nf90_real, (/ idimstation_id /), ivaromf_id) )

    ! End define mode.
    call check(nf90_enddef(incid))

    ! Writing
    call check(nf90_put_var(incid, ivarlon_id , self%diag(:)%Station_ID))
    call check(nf90_put_var(incid, ivarlon_id , self%diag(:)%Longitude))
    call check(nf90_put_var(incid, ivarlat_id , self%diag(:)%Latitude))
    call check(nf90_put_var(incid, ivarlev_id , self%diag(:)%Depth))
    call check(nf90_put_var(incid, ivarsigo_id , self%diag(:)%Observation_error))        
    call check(nf90_put_var(incid, ivarobs_id , self%diag(:)%Observation))
    call check(nf90_put_var(incid, ivaromf_id , self%diag(:)%Obs_Minus_Forecast))

    ! Close file.
    call check(nf90_close(incid))
    self%append=.true.
  end subroutine write_diag

  ! ------------------------------------------------------------------------------

  subroutine write_geoval(self,varname,geoval,arg_dim_name)

    use netcdf
    use ufo_vars_mod
    use ufo_geovals_mod
    
    implicit none

    class(diag_marine_obs)             , intent(in) :: self     !< Obs space diagnostics
    character(len=MAXVARLEN)           , intent(in) :: varname  !< One of var_ from ufo_vars_mod
    type(ufo_geoval)          , pointer, intent(in) :: geoval   !< 2D array for 1 geoval
    character(len=MAXVARLEN), optional , intent(in) :: arg_dim_name  !< Name for the second dimension
    !netcdf stuff    
    integer(kind=4) :: iNcid
    integer(kind=4) :: iDimStation_ID, iDimLev_ID
    integer(kind=4) :: iVargeoval_ID
    integer :: nlev, ndims
    character(len=MAXVARLEN) :: dim_name
    
    dim_name="nlev"
    if (present(arg_dim_name)) dim_name=arg_dim_name
    
    if (self%append) then  ! If file exists, append to it
       call check( nf90_open(self%filename, nf90_write, incid) )
       call check( nf90_inquire(incid, ndimensions = ndims) )
       call check( nf90_inq_dimid(incid, "nobs", idimstation_id) )
       if (ndims.eq.2) then
          call check( nf90_inq_dimid(incid, dim_name, idimlev_id) )
       end if
       call check( nf90_redef(incid) )
       if (ndims.eq.1) then
          nlev = geoval%nval          
          call check(nf90_def_dim(incid, dim_name, nlev, idimlev_id))
       end if
    else    
       call check(nf90_create(self%filename, nf90_clobber, incid))
       call check(nf90_def_dim(incid, "nobs", nf90_unlimited, idimstation_id))
       nlev = geoval%nval    
       call check(nf90_def_dim(incid, dim_name, nlev, idimlev_id))
    end if

    ! Define of variables.
    call check( nf90_def_var(incid, varname, nf90_real,  (/ idimlev_id, idimstation_id /), ivargeoval_id) )

    ! End define mode.
    call check(nf90_enddef(incid))

    ! Writing
    call check(nf90_put_var(incid, ivargeoval_id , geoval%vals))     

    ! Close file.
    call check(nf90_close(incid))
    
  end subroutine write_geoval

  ! ------------------------------------------------------------------------------  
  
  subroutine check(status)

    use netcdf
    IMPLICIT NONE
    integer(4), intent ( in) :: status
    if(status /= nf90_noerr) then
       print *, trim(nf90_strerror(status))
       stop "Stopped"
    end if
  end subroutine check

end module ufo_marine_ncutils