source: trunk/libf/bibio/simple.F90 @ 1

! $Id$
module simple

  implicit none

contains

  subroutine nf95_open(path, mode, ncid, chunksize, ncerr)

    use netcdf, only: nf90_open
    use handle_err_m, only: handle_err

    character(len=*), intent(in):: path
    integer, intent(in):: mode
    integer, intent(out):: ncid
    integer, intent(inout), optional:: chunksize
    integer, intent(out), optional:: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_open(path, mode, ncid, chunksize)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_open " // path, ncerr_not_opt)
    end if

  end subroutine nf95_open

  !************************

  subroutine nf95_inq_dimid(ncid, name, dimid, ncerr)

    use netcdf, only: nf90_inq_dimid
    use handle_err_m, only: handle_err

    integer,             intent( in) :: ncid
    character (len = *), intent( in) :: name
    integer,             intent(out) :: dimid
    integer, intent(out), optional:: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_inq_dimid(ncid, name, dimid)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_inq_dimid", ncerr_not_opt, ncid)
    end if

  end subroutine nf95_inq_dimid

  !************************

  subroutine nf95_inquire_dimension(ncid, dimid, name, len, ncerr)

    use netcdf, only: nf90_inquire_dimension
    use handle_err_m, only: handle_err

    integer,                       intent( in) :: ncid, dimid
    character (len = *), optional, intent(out) :: name
    integer,             optional, intent(out) :: len
    integer, intent(out), optional:: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_inquire_dimension(ncid, dimid, name, len)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_inquire_dimension", ncerr_not_opt, ncid)
    end if

  end subroutine nf95_inquire_dimension

  !************************

  subroutine nf95_inq_varid(ncid, name, varid, ncerr)

    use netcdf, only: nf90_inq_varid
    use handle_err_m, only: handle_err

    integer,             intent(in) :: ncid
    character (len = *), intent(in) :: name
    integer,             intent(out) :: varid
    integer, intent(out), optional:: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_inq_varid(ncid, name, varid)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_inq_varid, name = " // name, ncerr_not_opt, ncid)
    end if

  end subroutine nf95_inq_varid

  !************************

  subroutine nf95_inquire_variable(ncid, varid, name, xtype, ndims, dimids, &
       nAtts, ncerr)

    ! In "nf90_inquire_variable", "dimids" is an assumed-size array.
    ! This is the classical case of an array the size of which is
    ! unknown in the calling procedure, before the call.
    ! Here we use a better solution: a pointer argument array.
    ! This procedure associates and defines "dimids" if it is present.

    use netcdf, only: nf90_inquire_variable, nf90_max_var_dims
    use handle_err_m, only: handle_err

    integer, intent(in):: ncid, varid
    character(len = *), optional, intent(out):: name
    integer, optional, intent(out) :: xtype, ndims
    integer, dimension(:), optional, pointer :: dimids
    integer, optional, intent(out) :: nAtts
    integer, intent(out), optional :: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt
    integer dimids_local(nf90_max_var_dims)
    integer ndims_not_opt

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

    if (present(dimids)) then
       ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, &
            ndims_not_opt, dimids_local, nAtts)
       allocate(dimids(ndims_not_opt)) ! also works if ndims_not_opt == 0
       dimids = dimids_local(:ndims_not_opt)
       if (present(ndims)) ndims = ndims_not_opt
    else
       ncerr_not_opt = nf90_inquire_variable(ncid, varid, name, xtype, ndims, &
            nAtts=nAtts)
    end if

    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_inquire_variable", ncerr_not_opt, ncid)
    end if

  end subroutine nf95_inquire_variable

  !************************

  subroutine nf95_create(path, cmode, ncid, initialsize, chunksize, ncerr)
    
    use netcdf, only: nf90_create
    use handle_err_m, only: handle_err

    character (len = *), intent(in   ) :: path
    integer,             intent(in   ) :: cmode
    integer,             intent(  out) :: ncid
    integer, optional,   intent(in   ) :: initialsize
    integer, optional,   intent(inout) :: chunksize
    integer, intent(out), optional :: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_create(path, cmode, ncid, initialsize, chunksize)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_create " // path, ncerr_not_opt)
    end if

  end subroutine nf95_create

  !************************

  subroutine nf95_def_dim(ncid, name, len, dimid, ncerr)

    use netcdf, only: nf90_def_dim
    use handle_err_m, only: handle_err

    integer,             intent( in) :: ncid
    character (len = *), intent( in) :: name
    integer,             intent( in) :: len
    integer,             intent(out) :: dimid
    integer, intent(out), optional :: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_def_dim(ncid, name, len, dimid)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_def_dim", ncerr_not_opt, ncid)
    end if

  end subroutine nf95_def_dim

  !***********************

  subroutine nf95_redef(ncid, ncerr)

    use netcdf, only: nf90_redef
    use handle_err_m, only: handle_err

    integer, intent( in) :: ncid
    integer, intent(out), optional :: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_redef(ncid)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_redef", ncerr_not_opt, ncid)
    end if

  end subroutine nf95_redef
  
  !***********************

  subroutine nf95_enddef(ncid, h_minfree, v_align, v_minfree, r_align, ncerr)

    use netcdf, only: nf90_enddef
    use handle_err_m, only: handle_err

    integer,           intent( in) :: ncid
    integer, optional, intent( in) :: h_minfree, v_align, v_minfree, r_align
    integer, intent(out), optional :: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_enddef(ncid, h_minfree, v_align, v_minfree, r_align)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_enddef", ncerr_not_opt, ncid)
    end if

  end subroutine nf95_enddef

  !***********************

  subroutine nf95_close(ncid, ncerr)

    use netcdf, only: nf90_close
    use handle_err_m, only: handle_err

    integer, intent( in) :: ncid
    integer, intent(out), optional :: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_close(ncid)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_close", ncerr_not_opt)
    end if

  end subroutine nf95_close

  !***********************

  subroutine nf95_copy_att(ncid_in, varid_in, name, ncid_out, varid_out, ncerr)

    use netcdf, only: nf90_copy_att
    use handle_err_m, only: handle_err

    integer, intent( in):: ncid_in,  varid_in
    character(len=*), intent( in):: name
    integer, intent( in):: ncid_out, varid_out
    integer, intent(out), optional:: ncerr

    ! Variable local to the procedure:
    integer ncerr_not_opt

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

    ncerr_not_opt = nf90_copy_att(ncid_in, varid_in, name, ncid_out, varid_out)
    if (present(ncerr)) then
       ncerr = ncerr_not_opt
    else
       call handle_err("nf95_copy_att", ncerr_not_opt, ncid_out)
    end if

  end subroutine nf95_copy_att

end module simple