2413463588

Committed 27 Mar 2026 12:38PM UTC coverage: 6.981% (+7.0%) from 0.0%

Build Type

push

gitlab-ci

Committed by David Dickinson

Commit Message

Merged minor/add_qr_related_lapack_wrappers into minor/add_ranf_normal_to_give_normal_distribution

Coverage Stats

743 of 10643 relevant lines covered (6.98%)

16169.22 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/netcdf_utils.fpp

# include "define.inc"

!> Provides some convenience wrappers around netCDF procedures, mostly
!> for handling netCDF errors in a consistent manner, removing the
!> need to manually check the returned status code.
!>
!> @warning This module requires the preprocessor macro `NETCDF` to be
!>          defined. If it is not defined, you won't be able to `use`
!>          this module!
module netcdf_utils

#ifndef NETCDF
! Can't just do `#error` because `make depends` always preprocesses
! this file, so force a compile time error instead. `#warning` may get
! overlooked if it's much earlier in the build process
Error: You are attempting to compile netcdf_utils.fpp but are building without netcdf. Ensure you guard any 'use netcdf_utils' statements with '#ifdef NETCDF'

#else

  use netcdf, only: NF90_FLOAT, NF90_DOUBLE
  use netcdf, only: NF90_NOWRITE, NF90_CLOBBER, NF90_NOERR, NF90_MAX_NAME
  use netcdf, only: NF90_ENOTATT, NF90_ENOTVAR
  use netcdf, only: nf90_strerror
  use netcdf, only: nf90_inquire_variable
  use netcdf, only: nf90_inquire_dimension
  use netcdf, only: nf90_open, nf90_close
  use netcdf, only: nf90_inq_varid
  use netcdf, only: NF90_INT
  use netcdf, only: nf90_inq_varid, nf90_def_var
  use netcdf, only: nf90_inquire_attribute, nf90_put_att

  implicit none

  private

  public :: netcdf_error
  public :: get_netcdf_code_precision
  public :: check_netcdf_file_precision
  public :: netcdf_real, kind_nf, netcdf_int
  public :: ensure_netcdf_var_exists
  public :: ensure_netcdf_att_exists
  public :: ensure_netcdf_dim_exists
  public :: get_netcdf_dim_length
  public :: set_default_netcdf_compression
  public :: get_default_netcdf_compression
  public :: set_default_netcdf_compression_level
  public :: get_default_netcdf_compression_level

  !> Get the netCDF ID for a variable, creating it if it doesn't exist
  !> already
  interface ensure_netcdf_var_exists
    module procedure ensure_netcdf_var_exists_scalar
    module procedure ensure_netcdf_var_exists_onedim
    module procedure ensure_netcdf_var_exists_manydims
  end interface ensure_netcdf_var_exists

  !> Add an attribute to an existing netCDF variable
  interface ensure_netcdf_att_exists
    module procedure ensure_netcdf_att_exists_text
  end interface ensure_netcdf_att_exists

  !> Kind of netCDF types and constants
  integer, parameter :: kind_nf = kind (NF90_NOERR)
  !> netCDF type of default `real`
#ifdef SINGLE_PRECISION
  integer (kind_nf), parameter :: netcdf_real = NF90_FLOAT
#else
#ifdef QUAD_PRECISION
# error "Quad precision is incompatible with netCDF"
#else
  integer (kind_nf), parameter :: netcdf_real = NF90_DOUBLE
#endif
#endif
  !> netCDF type of default `integer`
  integer (kind_nf), parameter :: netcdf_int = NF90_INT

  ! Enables some internal print statements for debugging
  logical, parameter :: test = .false.

  ! The default use of compression
#ifdef GK_NETCDF_DEFAULT_COMPRESSION_ON
  logical :: use_compression_default = .true.
#else
  logical :: use_compression_default = .false.
#endif

  ! The default compression level. Can be between 1 (fast) and 9 (more)
  integer(kind_nf) :: deflate_level_default = 1

contains

  !> Returns the correct netCDF constant for the `real` kind in use
  function get_netcdf_code_precision () result (code_real)
    use constants, only: pi, kind_rs, kind_rd
    use file_utils, only: error_unit
    integer :: code_real

    ! second condition for Cray
    if ( (kind(pi)==kind_rs) .or. (kind_rs==kind_rd) ) then
       code_real = NF90_FLOAT
    else if (kind(pi)==kind_rd) then
       code_real = NF90_DOUBLE
    else
       write (error_unit(),*) &
            'ERROR: precision mismatch in get_netcdf_code_precision'
    end if
  end function get_netcdf_code_precision

  !> Check that an existing netCDF file uses the same `real` kind as
  !> the current simulation. Only prints a warning!
  subroutine check_netcdf_file_precision (ncid, filename)
    use file_utils, only: error_unit
    implicit none
    integer (kind_nf), intent (in), optional :: ncid
    character (*), intent (in), optional :: filename
    integer (kind_nf) :: file_real
    integer (kind_nf) :: ist, ncid_private, tid
    integer :: ierr

    ierr = error_unit()

    ist = NF90_NOERR
    file_real = -1

    if (present(ncid)) then
       if (present(filename)) then
          write (ierr,*) 'WARNING: in calling check_netcdf_file_precision'
          write (ierr,*) &
               'WARNING: both filename and ncid given -- filename ignored'
       end if
       ncid_private = ncid
    else
       if (present(filename)) then
          ist = nf90_open (filename, NF90_NOWRITE, ncid_private)
          if (test) write (error_unit(),*) &
               'opened netcdf file ', trim(filename), ' with ncid: ', &
               ncid_private, ' in check_netcdf_file_precision'
          if (ist /= NF90_NOERR) then
             call netcdf_error (ist, file=filename)
             return
          end if
       else
          write (ierr,*) 'ERROR: in calling check_netcdf_file_precision'
          write (ierr,*) 'ERROR: either filename or ncid should be given'
          return
       end if
    end if

    ist = nf90_inq_varid (ncid_private, 't0', tid)
    if (ist /= NF90_NOERR) call netcdf_error (ist, var='t0')

    ! get file_real
    if (ist == NF90_NOERR) then
       ist = nf90_inquire_variable (ncid_private, tid, xtype=file_real)
       if (ist /= NF90_NOERR) call netcdf_error (ist, ncid_private, tid)
    end if

    if (.not.present(ncid)) then
       ist = nf90_close (ncid_private)
       if (ist /= NF90_NOERR) call netcdf_error (ist, file=filename)
    end if

    ! check if file_real == code_real
    if (file_real /= netcdf_real) then
       write (ierr,*) 'WARNING: precision mismatch in input netcdf file and running code'
       if (file_real == NF90_FLOAT) then
          write (ierr,*) 'WARNING: file_real = NF90_FLOAT'
       else if (file_real == NF90_DOUBLE) then
          write (ierr,*) 'WARNING: file_real = NF90_DOUBLE'
       else
          write (ierr,*) 'WARNING: unknown file_real', file_real
       end if
       if (netcdf_real == NF90_FLOAT) then
          write (ierr,*) 'WARNING: code_real = NF90_FLOAT'
       else if (netcdf_real == NF90_DOUBLE) then
          write (ierr,*) 'WARNING: code_real = NF90_DOUBLE'
       else
          write (ierr,*) 'WARNING: unknown code_real'
       end if
    end if
  end subroutine check_netcdf_file_precision

  !> Convert a netCDF error code to a nice error message. Writes to
  !> [[file_utils:error_unit]]
  !>
  !> All the arguments except `istatus` are optional and are used to
  !> give more detailed information about the error
  !>
  !> The `abort` argument will abort the simulation
  subroutine netcdf_error &
       (istatus, ncid, varid, dimid, file, dim, var, att, message, abort)

    use mp, only: mp_abort
    use file_utils, only: error_unit
    use netcdf, only: NF90_GLOBAL
    implicit none
    !> The netCDF error code to convert to a message
    integer (kind_nf), intent (in) :: istatus
    !> netCDF ID of the file
    integer (kind_nf), intent (in), optional :: ncid
    !> netCDF ID of the variable
    integer (kind_nf), intent (in), optional :: varid
    !> netCDF ID of the dimension
    integer (kind_nf), intent (in), optional :: dimid
    !> Name of the file
    character (*), intent (in), optional :: file
    !> Name of the dimension
    character (*), intent (in), optional :: dim
    !> Name of the variable
    character (*), intent (in), optional :: var
    !> Name of the attribute
    character (*), intent (in), optional :: att
    !> Custom text to append to the error message
    character (*), intent (in), optional :: message
    !> Immediately abort the program if present and true
    logical, intent (in), optional :: abort
    integer (kind_nf) :: ist
    integer :: ierr
    character (20) :: varname, dimname

    ierr = error_unit()

    write (ierr, '(2a)', advance='no') 'ERROR: ', trim (nf90_strerror (istatus))

    if (present(file)) &
         write (ierr, '(2a)', advance='no') ' in file: ', trim (file)

    if (present(dim)) &
         write (ierr, '(2a)', advance='no') ' in dimension: ', trim (dim)

    if (present(var)) &
         write (ierr, '(2a)', advance='no') ' in variable: ', trim (var)

    if (present(varid)) then
       if (present(ncid)) then
          if (present(att) ) then
             if (varid == NF90_GLOBAL) then
                write (ierr, '(2a)') ' in global attribute: ', trim(att)
             else
                write (ierr, '(2a)') ' with the attribute: ', trim(att)
             end if
          else
             ist = nf90_inquire_variable (ncid, varid, varname)
             if (ist == NF90_NOERR) then
                write (ierr, '(a,i8,2a)', advance='no') ' in varid: ', varid, &
                     & ' variable name: ', trim (varname)
             else
                write (ierr, *) ''
                write (ierr, '(3a,i8,a,i8)', advance='no') 'ERROR in netcdf_error: ', &
                     trim (nf90_strerror(ist)), ' in varid: ', varid, &
                     ', ncid: ', ncid
             end if
          end if
       else
          write (ierr, *) ''
          write (ierr, '(2a)', advance='no') 'ERROR in netcdf_error: ', &
               & 'ncid missing while varid present in the argument'
       end if
    end if

    if (present(dimid)) then
       if (present(ncid)) then
          ist = nf90_inquire_dimension (ncid, dimid, dimname)
          if (ist == NF90_NOERR) then
             write (ierr, '(a,i8,2a)', advance='no') ' in dimid: ', dimid, &
                  & ' dimension name: ', trim (dimname)
          else
             write (ierr, *) ''
             write (ierr, '(3a,i8,a,i8)', advance='no') 'ERROR in netcdf_error: ', &
                  trim (nf90_strerror(ist)), ' in dimid: ', dimid, &
                  ', ncid: ', ncid
          end if
       else
          write (ierr, *) ''
          write (ierr, '(2a)', advance='no') 'ERROR in netcdf_error: ', &
               & 'ncid missing while dimid present in the argument'
       end if
    end if

    if (present(message)) write (ierr, '(a)', advance='no') trim(message)

    ! append line-break
    write(ierr,*)

    ! maybe this switching is not necessary.
    ! if error is detected, the program should abort immediately
    if(present(abort)) then
       if(abort) then
          call mp_abort('Aborted by netcdf_error')
       endif
    endif
  end subroutine netcdf_error

  !> Get the netCDF ID for a variable, creating it if it doesn't exist
  !> already. Aborts if any errors are detected.
  subroutine ensure_netcdf_var_exists_scalar(file_id, var_name, var_type, var_id)
    !> ID of the file or group to look for or create the variable under
    integer(kind_nf), intent(in) :: file_id
    !> Name of the variable
    character(len=*), intent(in) :: var_name
    !> The netCDF type of the variable
    integer(kind_nf), intent(in) :: var_type
    !> The netCDF ID of the variable under `file_id`
    integer(kind_nf), intent(out) :: var_id

    ! Error code of the netCDF calls
    integer(kind_nf) :: status

    status = nf90_inq_varid(file_id, var_name, var_id)
    ! Variable doesn't exist, so let's create it
    if (status == NF90_ENOTVAR) then
       status = nf90_def_var(file_id, var_name, var_type, var_id)
    end if
    ! Something went wrong with one of the previous two calls
    if (status /= NF90_NOERR) then
      call netcdf_error(status, var=var_name, varid=var_id, &
                        message="(ensure_netcdf_var_exists)", abort=.true.)
    end if
  end subroutine ensure_netcdf_var_exists_scalar

  !> Get the netCDF ID for a variable, creating it if it doesn't exist
  !> already. Aborts if any errors are detected.
  subroutine ensure_netcdf_var_exists_onedim(file_id, var_name, var_type, dim_id, var_id, &
       compress, deflate_level)
    !> ID of the file or group to look for or create the variable under
    integer(kind_nf), intent(in) :: file_id
    !> Name of the variable
    character(len=*), intent(in) :: var_name
    !> The netCDF type of the variable
    integer(kind_nf), intent(in) :: var_type
    !> Array of dimension IDs
    integer(kind_nf), intent(in) :: dim_id
    !> The netCDF ID of the variable under `file_id`
    integer(kind_nf), intent(out) :: var_id
    !> Do we want to use compression for this variable
    logical, intent(in), optional :: compress
    !> The compression level to use for this variable
    integer(kind_nf), intent(in), optional :: deflate_level

    call ensure_netcdf_var_exists_manydims(file_id, var_name, var_type, [dim_id], &
         var_id, compress, deflate_level)
  end subroutine ensure_netcdf_var_exists_onedim

  !> Get the netCDF ID for a variable, creating it if it doesn't exist
  !> already. Aborts if any errors are detected.
  subroutine ensure_netcdf_var_exists_manydims(file_id, var_name, var_type, dim_id, var_id, &
       compress, deflate_level)
    use optionals, only: get_option_with_default
    !> ID of the file or group to look for or create the variable under
    integer(kind_nf), intent(in) :: file_id
    !> Name of the variable
    character(len=*), intent(in) :: var_name
    !> The netCDF type of the variable
    integer(kind_nf), intent(in) :: var_type
    !> Array of dimension IDs
    integer(kind_nf), dimension(:), intent(in) :: dim_id
    !> The netCDF ID of the variable under `file_id`
    integer(kind_nf), intent(out) :: var_id
    !> Do we want to use compression for this variable
    logical, intent(in), optional :: compress
    !> The compression level to use for this variable
    integer(kind_nf), intent(in), optional :: deflate_level

    ! Error code of the netCDF calls
    integer(kind_nf) :: status
    ! Do we want to use compression?
    logical :: use_compression
    ! What compression level do we want to use?
    integer(kind_nf) :: compression_level

    status = nf90_inq_varid(file_id, var_name, var_id)
    ! Variable doesn't exist, so let's create it
    if (status == NF90_ENOTVAR) then
       use_compression = get_option_with_default(compress, use_compression_default)
       compression_level = 0
       if (use_compression) &
            compression_level = get_option_with_default(deflate_level, deflate_level_default)

       status = nf90_def_var(file_id, var_name, var_type, dim_id, var_id, &
            deflate_level = compression_level, &
            shuffle = use_compression &
            )
    end if
    ! Something went wrong with one of the previous two calls
    if (status /= NF90_NOERR) then
      call netcdf_error(status, var=var_name, varid=var_id, &
                        message="(ensure_netcdf_var_exists)", abort=.true.)
    end if
  end subroutine ensure_netcdf_var_exists_manydims

  !> Add an attribute to an existing netCDF variable. Aborts if any
  !> errors are detected.
  subroutine ensure_netcdf_att_exists_text(file_id, var_id, att_name, att_text)
    !> ID of the file or group to look for or create the variable under
    integer(kind_nf), intent(in) :: file_id
    !> The netCDF ID of the variable under `file_id`
    integer(kind_nf), intent(in) :: var_id
    !> Name of the attribute
    character(len=*), intent(in) :: att_name
    !> Attribute text to store
    character(len=*), intent(in) :: att_text

    ! Error code of the netCDF calls
    integer(kind_nf) :: status

    status = nf90_inquire_attribute(file_id, var_id, att_name)
    ! Attribute doesn't exist, so let's create it
    if (status == NF90_ENOTATT) then
      status = nf90_put_att(file_id, var_id, att_name, att_text)
    end if
    ! Something went wrong with one of the previous two calls
    if (status /= NF90_NOERR) then
      call netcdf_error(status, file_id, var_id, att=att_name, &
                        message="(ensure_netcdf_att_exists)", abort=.true.)
    end if
  end subroutine ensure_netcdf_att_exists_text

  !> Get the netCDF ID for a dimension, creating it if it doesn't
  !> exist already. Aborts if any errors are detected.
  subroutine ensure_netcdf_dim_exists(file_id, dim_name, dim_size, dim_id)
    use netcdf, only: nf90_inq_dimid, nf90_def_dim, NF90_NOERR, NF90_EBADDIM
    !> ID of the file or group to look for or create the dimension under
    integer(kind_nf), intent(in) :: file_id
    !> Name of the dimension
    character(len=*), intent(in) :: dim_name
    !> The size of the dimension
    integer(kind_nf), intent(in) :: dim_size
    !> The netCDF ID of the dimension under `file_id`
    integer(kind_nf), intent(out) :: dim_id

    ! Error code of the netCDF calls
    integer(kind_nf) :: status

    status = nf90_inq_dimid(file_id, dim_name, dim_id)
    ! Dimension doesn't exist, so let's create it
    if (status == NF90_EBADDIM) then
      status = nf90_def_dim(file_id, dim_name, dim_size, dim_id)
    end if
    ! Something went wrong with one of the previous two calls
    if (status /= NF90_NOERR) then
      call netcdf_error(status, dim=dim_name, message="(ensure_netcdf_dim_exists)", abort=.true.)
    end if
  end subroutine ensure_netcdf_dim_exists

  !> Wrapper around `nf90_inquire_dimension`. Aborts if any errors are
  !> detected.
  function get_netcdf_dim_length(file_id, dim_id) result(length)
    integer :: length
    !> NetCDF ID of the file
    integer(kind_nf), intent(in) :: file_id
    !> NetCDF ID of the dimension
    integer(kind_nf), intent(in) :: dim_id

    ! Temporary variable for the dimension name
    character(len=NF90_MAX_NAME) :: dim_name
    ! NetCDF error status
    integer :: status

    ! This could be less reliant on module-level variables if we
    ! passed in the dimension name and used nf90_inq_dim to get the ID
    status = nf90_inquire_dimension(file_id, dim_id, dim_name, length)
    if (status /= NF90_NOERR) then
      call netcdf_error(status, &
                        dim=trim(dim_name), &
                        message="(get_netcdf_dim_length)", &
                        abort=.true.)
    end if
  end function get_netcdf_dim_length

  !> Returns the current value of use_compression_default
  logical function get_default_netcdf_compression() result(compression_flag)
    implicit none
    compression_flag = use_compression_default
  end function get_default_netcdf_compression

  !> Set the value of use_compression_default
  subroutine set_default_netcdf_compression(compression_flag)
    implicit none
    logical, intent(in) :: compression_flag
    use_compression_default = compression_flag
  end subroutine set_default_netcdf_compression

  !> Returns the current value of deflate_level_default
  integer(kind_nf) function get_default_netcdf_compression_level() result(compression_level)
    implicit none
    compression_level = deflate_level_default
  end function get_default_netcdf_compression_level

  !> Set the value of deflate_level_default
  subroutine set_default_netcdf_compression_level(compression_level)
    implicit none
    integer(kind_nf), intent(in) :: compression_level
    deflate_level_default = compression_level
  end subroutine set_default_netcdf_compression_level

#endif
end module netcdf_utils

1	# include "define.inc"
2
3	!> Provides some convenience wrappers around netCDF procedures, mostly
4	!> for handling netCDF errors in a consistent manner, removing the
5	!> need to manually check the returned status code.
6	!>
7	!> @warning This module requires the preprocessor macro `NETCDF` to be
8	!> defined. If it is not defined, you won't be able to `use`
9	!> this module!
10	module netcdf_utils
11
12	#ifndef NETCDF
13	! Can't just do `#error` because `make depends` always preprocesses
14	! this file, so force a compile time error instead. `#warning` may get
15	! overlooked if it's much earlier in the build process
16	Error: You are attempting to compile netcdf_utils.fpp but are building without netcdf. Ensure you guard any 'use netcdf_utils' statements with '#ifdef NETCDF'
17
18	#else
19
20	use netcdf, only: NF90_FLOAT, NF90_DOUBLE
21	use netcdf, only: NF90_NOWRITE, NF90_CLOBBER, NF90_NOERR, NF90_MAX_NAME
22	use netcdf, only: NF90_ENOTATT, NF90_ENOTVAR
23	use netcdf, only: nf90_strerror
24	use netcdf, only: nf90_inquire_variable
25	use netcdf, only: nf90_inquire_dimension
26	use netcdf, only: nf90_open, nf90_close
27	use netcdf, only: nf90_inq_varid
28	use netcdf, only: NF90_INT
29	use netcdf, only: nf90_inq_varid, nf90_def_var
30	use netcdf, only: nf90_inquire_attribute, nf90_put_att
31
32	implicit none
33
34	private
35
36	public :: netcdf_error
37	public :: get_netcdf_code_precision
38	public :: check_netcdf_file_precision
39	public :: netcdf_real, kind_nf, netcdf_int
40	public :: ensure_netcdf_var_exists
41	public :: ensure_netcdf_att_exists
42	public :: ensure_netcdf_dim_exists
43	public :: get_netcdf_dim_length
44	public :: set_default_netcdf_compression
45	public :: get_default_netcdf_compression
46	public :: set_default_netcdf_compression_level
47	public :: get_default_netcdf_compression_level
48
49	!> Get the netCDF ID for a variable, creating it if it doesn't exist
50	!> already
51	interface ensure_netcdf_var_exists
52	module procedure ensure_netcdf_var_exists_scalar
53	module procedure ensure_netcdf_var_exists_onedim
54	module procedure ensure_netcdf_var_exists_manydims
55	end interface ensure_netcdf_var_exists
56
57	!> Add an attribute to an existing netCDF variable
58	interface ensure_netcdf_att_exists
59	module procedure ensure_netcdf_att_exists_text
60	end interface ensure_netcdf_att_exists
61
62	!> Kind of netCDF types and constants
63	integer, parameter :: kind_nf = kind (NF90_NOERR)
64	!> netCDF type of default `real`
65	#ifdef SINGLE_PRECISION
66	integer (kind_nf), parameter :: netcdf_real = NF90_FLOAT
67	#else
68	#ifdef QUAD_PRECISION
69	# error "Quad precision is incompatible with netCDF"
70	#else
71	integer (kind_nf), parameter :: netcdf_real = NF90_DOUBLE
72	#endif
73	#endif
74	!> netCDF type of default `integer`
75	integer (kind_nf), parameter :: netcdf_int = NF90_INT
76
77	! Enables some internal print statements for debugging
78	logical, parameter :: test = .false.
79
80	! The default use of compression
81	#ifdef GK_NETCDF_DEFAULT_COMPRESSION_ON
82	logical :: use_compression_default = .true.
83	#else
84	logical :: use_compression_default = .false.
85	#endif
86
87	! The default compression level. Can be between 1 (fast) and 9 (more)
88	integer(kind_nf) :: deflate_level_default = 1
89
90	contains
91
92	!> Returns the correct netCDF constant for the `real` kind in use
93	function get_netcdf_code_precision () result (code_real)	×
94	use constants, only: pi, kind_rs, kind_rd
95	use file_utils, only: error_unit
96	integer :: code_real
97
98	! second condition for Cray
99	if ( (kind(pi)==kind_rs) .or. (kind_rs==kind_rd) ) then	×
100	code_real = NF90_FLOAT
101	else if (kind(pi)==kind_rd) then
102	code_real = NF90_DOUBLE
103	else
104	write (error_unit(),*) &
105	'ERROR: precision mismatch in get_netcdf_code_precision'
106	end if
107	end function get_netcdf_code_precision	×
108
109	!> Check that an existing netCDF file uses the same `real` kind as
110	!> the current simulation. Only prints a warning!
111	subroutine check_netcdf_file_precision (ncid, filename)	×
112	use file_utils, only: error_unit
113	implicit none
114	integer (kind_nf), intent (in), optional :: ncid
115	character (*), intent (in), optional :: filename
116	integer (kind_nf) :: file_real
117	integer (kind_nf) :: ist, ncid_private, tid
118	integer :: ierr
119
120	ierr = error_unit()	×
121
122	ist = NF90_NOERR	×
123	file_real = -1	×
124
125	if (present(ncid)) then	×
126	if (present(filename)) then	×
127	write (ierr,*) 'WARNING: in calling check_netcdf_file_precision'	×
128	write (ierr,*) &
129	'WARNING: both filename and ncid given -- filename ignored'	×
130	end if
131	ncid_private = ncid	×
132	else
133	if (present(filename)) then	×
134	ist = nf90_open (filename, NF90_NOWRITE, ncid_private)	×
135	if (test) write (error_unit(),*) &
136	'opened netcdf file ', trim(filename), ' with ncid: ', &
137	ncid_private, ' in check_netcdf_file_precision'
138	if (ist /= NF90_NOERR) then	×
139	call netcdf_error (ist, file=filename)	×
140	return	×
141	end if
142	else
143	write (ierr,*) 'ERROR: in calling check_netcdf_file_precision'	×
144	write (ierr,*) 'ERROR: either filename or ncid should be given'	×
145	return	×
146	end if
147	end if
148
149	ist = nf90_inq_varid (ncid_private, 't0', tid)	×
150	if (ist /= NF90_NOERR) call netcdf_error (ist, var='t0')	×
151
152	! get file_real
153	if (ist == NF90_NOERR) then	×
154	ist = nf90_inquire_variable (ncid_private, tid, xtype=file_real)	×
155	if (ist /= NF90_NOERR) call netcdf_error (ist, ncid_private, tid)	×
156	end if
157
158	if (.not.present(ncid)) then	×
159	ist = nf90_close (ncid_private)	×
160	if (ist /= NF90_NOERR) call netcdf_error (ist, file=filename)	×
161	end if
162
163	! check if file_real == code_real
164	if (file_real /= netcdf_real) then	×
165	write (ierr,*) 'WARNING: precision mismatch in input netcdf file and running code'	×
166	if (file_real == NF90_FLOAT) then	×
167	write (ierr,*) 'WARNING: file_real = NF90_FLOAT'	×
168	else if (file_real == NF90_DOUBLE) then	×
169	write (ierr,*) 'WARNING: file_real = NF90_DOUBLE'	×
170	else
171	write (ierr,*) 'WARNING: unknown file_real', file_real	×
172	end if
173	if (netcdf_real == NF90_FLOAT) then
174	write (ierr,*) 'WARNING: code_real = NF90_FLOAT'
175	else if (netcdf_real == NF90_DOUBLE) then
176	write (ierr,*) 'WARNING: code_real = NF90_DOUBLE'	×
177	else
178	write (ierr,*) 'WARNING: unknown code_real'
179	end if
180	end if
181	end subroutine check_netcdf_file_precision	×
182
183	!> Convert a netCDF error code to a nice error message. Writes to
184	!> [[file_utils:error_unit]]
185	!>
186	!> All the arguments except `istatus` are optional and are used to
187	!> give more detailed information about the error
188	!>
189	!> The `abort` argument will abort the simulation
190	subroutine netcdf_error &	×
191	(istatus, ncid, varid, dimid, file, dim, var, att, message, abort)
192
193	use mp, only: mp_abort
194	use file_utils, only: error_unit
195	use netcdf, only: NF90_GLOBAL
196	implicit none
197	!> The netCDF error code to convert to a message
198	integer (kind_nf), intent (in) :: istatus
199	!> netCDF ID of the file
200	integer (kind_nf), intent (in), optional :: ncid
201	!> netCDF ID of the variable
202	integer (kind_nf), intent (in), optional :: varid
203	!> netCDF ID of the dimension
204	integer (kind_nf), intent (in), optional :: dimid
205	!> Name of the file
206	character (*), intent (in), optional :: file
207	!> Name of the dimension
208	character (*), intent (in), optional :: dim
209	!> Name of the variable
210	character (*), intent (in), optional :: var
211	!> Name of the attribute
212	character (*), intent (in), optional :: att
213	!> Custom text to append to the error message
214	character (*), intent (in), optional :: message
215	!> Immediately abort the program if present and true
216	logical, intent (in), optional :: abort
217	integer (kind_nf) :: ist
218	integer :: ierr
219	character (20) :: varname, dimname
220
221	ierr = error_unit()	×
222
223	write (ierr, '(2a)', advance='no') 'ERROR: ', trim (nf90_strerror (istatus))	×
224
225	if (present(file)) &	×
226	write (ierr, '(2a)', advance='no') ' in file: ', trim (file)	×
227
228	if (present(dim)) &	×
229	write (ierr, '(2a)', advance='no') ' in dimension: ', trim (dim)	×
230
231	if (present(var)) &	×
232	write (ierr, '(2a)', advance='no') ' in variable: ', trim (var)	×
233
234	if (present(varid)) then	×
235	if (present(ncid)) then	×
236	if (present(att) ) then	×
237	if (varid == NF90_GLOBAL) then	×
238	write (ierr, '(2a)') ' in global attribute: ', trim(att)	×
239	else
240	write (ierr, '(2a)') ' with the attribute: ', trim(att)	×
241	end if
242	else
243	ist = nf90_inquire_variable (ncid, varid, varname)	×
244	if (ist == NF90_NOERR) then	×
245	write (ierr, '(a,i8,2a)', advance='no') ' in varid: ', varid, &	×
246	& ' variable name: ', trim (varname)	×
247	else
248	write (ierr, *) ''	×
249	write (ierr, '(3a,i8,a,i8)', advance='no') 'ERROR in netcdf_error: ', &	×
250	trim (nf90_strerror(ist)), ' in varid: ', varid, &	×
251	', ncid: ', ncid	×
252	end if
253	end if
254	else
255	write (ierr, *) ''	×
256	write (ierr, '(2a)', advance='no') 'ERROR in netcdf_error: ', &	×
257	& 'ncid missing while varid present in the argument'	×
258	end if
259	end if
260
261	if (present(dimid)) then	×
262	if (present(ncid)) then	×
263	ist = nf90_inquire_dimension (ncid, dimid, dimname)	×
264	if (ist == NF90_NOERR) then	×
265	write (ierr, '(a,i8,2a)', advance='no') ' in dimid: ', dimid, &	×
266	& ' dimension name: ', trim (dimname)	×
267	else
268	write (ierr, *) ''	×
269	write (ierr, '(3a,i8,a,i8)', advance='no') 'ERROR in netcdf_error: ', &	×
270	trim (nf90_strerror(ist)), ' in dimid: ', dimid, &	×
271	', ncid: ', ncid	×
272	end if
273	else
274	write (ierr, *) ''	×
275	write (ierr, '(2a)', advance='no') 'ERROR in netcdf_error: ', &	×
276	& 'ncid missing while dimid present in the argument'	×
277	end if
278	end if
279
280	if (present(message)) write (ierr, '(a)', advance='no') trim(message)	×
281
282	! append line-break
283	write(ierr,*)	×
284
285	! maybe this switching is not necessary.
286	! if error is detected, the program should abort immediately
287	if(present(abort)) then	×
288	if(abort) then	×
289	call mp_abort('Aborted by netcdf_error')	×
290	endif
291	endif
292	end subroutine netcdf_error	×
293
294	!> Get the netCDF ID for a variable, creating it if it doesn't exist
295	!> already. Aborts if any errors are detected.
296	subroutine ensure_netcdf_var_exists_scalar(file_id, var_name, var_type, var_id)	×
297	!> ID of the file or group to look for or create the variable under
298	integer(kind_nf), intent(in) :: file_id
299	!> Name of the variable
300	character(len=*), intent(in) :: var_name
301	!> The netCDF type of the variable
302	integer(kind_nf), intent(in) :: var_type
303	!> The netCDF ID of the variable under `file_id`
304	integer(kind_nf), intent(out) :: var_id
305
306	! Error code of the netCDF calls
307	integer(kind_nf) :: status
308
309	status = nf90_inq_varid(file_id, var_name, var_id)	×
310	! Variable doesn't exist, so let's create it
311	if (status == NF90_ENOTVAR) then	×
312	status = nf90_def_var(file_id, var_name, var_type, var_id)	×
313	end if
314	! Something went wrong with one of the previous two calls
315	if (status /= NF90_NOERR) then	×
316	call netcdf_error(status, var=var_name, varid=var_id, &
317	message="(ensure_netcdf_var_exists)", abort=.true.)	×
318	end if
319	end subroutine ensure_netcdf_var_exists_scalar	×
320
321	!> Get the netCDF ID for a variable, creating it if it doesn't exist
322	!> already. Aborts if any errors are detected.
323	subroutine ensure_netcdf_var_exists_onedim(file_id, var_name, var_type, dim_id, var_id, &	×
324	compress, deflate_level)
325	!> ID of the file or group to look for or create the variable under
326	integer(kind_nf), intent(in) :: file_id
327	!> Name of the variable
328	character(len=*), intent(in) :: var_name
329	!> The netCDF type of the variable
330	integer(kind_nf), intent(in) :: var_type
331	!> Array of dimension IDs
332	integer(kind_nf), intent(in) :: dim_id
333	!> The netCDF ID of the variable under `file_id`
334	integer(kind_nf), intent(out) :: var_id
335	!> Do we want to use compression for this variable
336	logical, intent(in), optional :: compress
337	!> The compression level to use for this variable
338	integer(kind_nf), intent(in), optional :: deflate_level
339
340	call ensure_netcdf_var_exists_manydims(file_id, var_name, var_type, [dim_id], &
341	var_id, compress, deflate_level)	×
342	end subroutine ensure_netcdf_var_exists_onedim	×
343
344	!> Get the netCDF ID for a variable, creating it if it doesn't exist
345	!> already. Aborts if any errors are detected.
346	subroutine ensure_netcdf_var_exists_manydims(file_id, var_name, var_type, dim_id, var_id, &	×
347	compress, deflate_level)
348	use optionals, only: get_option_with_default
349	!> ID of the file or group to look for or create the variable under
350	integer(kind_nf), intent(in) :: file_id
351	!> Name of the variable
352	character(len=*), intent(in) :: var_name
353	!> The netCDF type of the variable
354	integer(kind_nf), intent(in) :: var_type
355	!> Array of dimension IDs
356	integer(kind_nf), dimension(:), intent(in) :: dim_id
357	!> The netCDF ID of the variable under `file_id`
358	integer(kind_nf), intent(out) :: var_id
359	!> Do we want to use compression for this variable
360	logical, intent(in), optional :: compress
361	!> The compression level to use for this variable
362	integer(kind_nf), intent(in), optional :: deflate_level
363
364	! Error code of the netCDF calls
365	integer(kind_nf) :: status
366	! Do we want to use compression?
367	logical :: use_compression
368	! What compression level do we want to use?
369	integer(kind_nf) :: compression_level
370
371	status = nf90_inq_varid(file_id, var_name, var_id)	×
372	! Variable doesn't exist, so let's create it
373	if (status == NF90_ENOTVAR) then	×
374	use_compression = get_option_with_default(compress, use_compression_default)	×
375	compression_level = 0	×
376	if (use_compression) &	×
377	compression_level = get_option_with_default(deflate_level, deflate_level_default)	×
378
379	status = nf90_def_var(file_id, var_name, var_type, dim_id, var_id, &	×
380	deflate_level = compression_level, &
381	shuffle = use_compression &
382	)	×
383	end if
384	! Something went wrong with one of the previous two calls
385	if (status /= NF90_NOERR) then	×
386	call netcdf_error(status, var=var_name, varid=var_id, &
387	message="(ensure_netcdf_var_exists)", abort=.true.)	×
388	end if
389	end subroutine ensure_netcdf_var_exists_manydims	×
390
391	!> Add an attribute to an existing netCDF variable. Aborts if any
392	!> errors are detected.
393	subroutine ensure_netcdf_att_exists_text(file_id, var_id, att_name, att_text)	×
394	!> ID of the file or group to look for or create the variable under
395	integer(kind_nf), intent(in) :: file_id
396	!> The netCDF ID of the variable under `file_id`
397	integer(kind_nf), intent(in) :: var_id
398	!> Name of the attribute
399	character(len=*), intent(in) :: att_name
400	!> Attribute text to store
401	character(len=*), intent(in) :: att_text
402
403	! Error code of the netCDF calls
404	integer(kind_nf) :: status
405
406	status = nf90_inquire_attribute(file_id, var_id, att_name)	×
407	! Attribute doesn't exist, so let's create it
408	if (status == NF90_ENOTATT) then	×
409	status = nf90_put_att(file_id, var_id, att_name, att_text)	×
410	end if
411	! Something went wrong with one of the previous two calls
412	if (status /= NF90_NOERR) then	×
413	call netcdf_error(status, file_id, var_id, att=att_name, &
414	message="(ensure_netcdf_att_exists)", abort=.true.)	×
415	end if
416	end subroutine ensure_netcdf_att_exists_text	×
417
418	!> Get the netCDF ID for a dimension, creating it if it doesn't
419	!> exist already. Aborts if any errors are detected.
420	subroutine ensure_netcdf_dim_exists(file_id, dim_name, dim_size, dim_id)	×
421	use netcdf, only: nf90_inq_dimid, nf90_def_dim, NF90_NOERR, NF90_EBADDIM
422	!> ID of the file or group to look for or create the dimension under
423	integer(kind_nf), intent(in) :: file_id
424	!> Name of the dimension
425	character(len=*), intent(in) :: dim_name
426	!> The size of the dimension
427	integer(kind_nf), intent(in) :: dim_size
428	!> The netCDF ID of the dimension under `file_id`
429	integer(kind_nf), intent(out) :: dim_id
430
431	! Error code of the netCDF calls
432	integer(kind_nf) :: status
433
434	status = nf90_inq_dimid(file_id, dim_name, dim_id)	×
435	! Dimension doesn't exist, so let's create it
436	if (status == NF90_EBADDIM) then	×
437	status = nf90_def_dim(file_id, dim_name, dim_size, dim_id)	×
438	end if
439	! Something went wrong with one of the previous two calls
440	if (status /= NF90_NOERR) then	×
441	call netcdf_error(status, dim=dim_name, message="(ensure_netcdf_dim_exists)", abort=.true.)	×
442	end if
443	end subroutine ensure_netcdf_dim_exists	×
444
445	!> Wrapper around `nf90_inquire_dimension`. Aborts if any errors are
446	!> detected.
447	function get_netcdf_dim_length(file_id, dim_id) result(length)	×
448	integer :: length
449	!> NetCDF ID of the file
450	integer(kind_nf), intent(in) :: file_id
451	!> NetCDF ID of the dimension
452	integer(kind_nf), intent(in) :: dim_id
453
454	! Temporary variable for the dimension name
455	character(len=NF90_MAX_NAME) :: dim_name
456	! NetCDF error status
457	integer :: status
458
459	! This could be less reliant on module-level variables if we
460	! passed in the dimension name and used nf90_inq_dim to get the ID
461	status = nf90_inquire_dimension(file_id, dim_id, dim_name, length)	×
462	if (status /= NF90_NOERR) then	×
463	call netcdf_error(status, &
464	dim=trim(dim_name), &
465	message="(get_netcdf_dim_length)", &
466	abort=.true.)	×
467	end if
468	end function get_netcdf_dim_length	×
469
470	!> Returns the current value of use_compression_default
471	logical function get_default_netcdf_compression() result(compression_flag)	×
472	implicit none
473	compression_flag = use_compression_default	×
474	end function get_default_netcdf_compression	×
475
476	!> Set the value of use_compression_default
477	subroutine set_default_netcdf_compression(compression_flag)	×
478	implicit none
479	logical, intent(in) :: compression_flag
480	use_compression_default = compression_flag	×
481	end subroutine set_default_netcdf_compression	×
482
483	!> Returns the current value of deflate_level_default
484	integer(kind_nf) function get_default_netcdf_compression_level() result(compression_level)	×
485	implicit none
486	compression_level = deflate_level_default	×
487	end function get_default_netcdf_compression_level	×
488
489	!> Set the value of deflate_level_default
490	subroutine set_default_netcdf_compression_level(compression_level)	×
491	implicit none
492	integer(kind_nf), intent(in) :: compression_level
493	deflate_level_default = compression_level	×
494	end subroutine set_default_netcdf_compression_level	×
495
496	#endif
497	end module netcdf_utils

gyrokinetics / utils / 2413463588

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous