zinit_dims_ok Function

public function zinit_dims_ok(filename, t_var, nx_phys, ny_phys) result(ok)

Uses

    • netcdf
  • proc~~zinit_dims_ok~~UsesGraph proc~zinit_dims_ok zinit_dims_ok netcdf netcdf proc~zinit_dims_ok->netcdf

match (nx_phys, ny_phys). Returns .false. on mismatch or I/O error; does NOT error stop — safe from test code.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: filename
character(len=*), intent(in) :: t_var
integer, intent(in) :: nx_phys
integer, intent(in) :: ny_phys

Return Value logical


Calls

proc~~zinit_dims_ok~~CallsGraph proc~zinit_dims_ok zinit_dims_ok nf90_close nf90_close proc~zinit_dims_ok->nf90_close nf90_inq_varid nf90_inq_varid proc~zinit_dims_ok->nf90_inq_varid nf90_inquire_dimension nf90_inquire_dimension proc~zinit_dims_ok->nf90_inquire_dimension nf90_inquire_variable nf90_inquire_variable proc~zinit_dims_ok->nf90_inquire_variable nf90_open nf90_open proc~zinit_dims_ok->nf90_open

Variables

Type Visibility Attributes Name Initial
integer, private :: d1_len
character(len=64), private :: d1_name
integer, private :: d2_len
integer, private :: d3_len
integer, private :: ierr
integer, private :: ncid
logical, private :: needs_transpose
integer, private :: var_dimids(3)
integer, private :: var_ndims
integer, private :: varid

Source Code

   function zinit_dims_ok(filename, t_var, nx_phys, ny_phys) result(ok)
      !! Validator: true iff the temperature variable's horizontal dims
      !! match `(nx_phys, ny_phys)`.  Returns `.false.` on mismatch or
      !! I/O error; does NOT `error stop` — safe from test code.
      use netcdf, only: nf90_open, nf90_nowrite, nf90_close
      character(len=*), intent(in) :: filename, t_var
      integer, intent(in) :: nx_phys, ny_phys
      logical :: ok

      integer :: ncid, varid, ierr, var_ndims
      integer :: var_dimids(3)
      integer :: d1_len, d2_len, d3_len
      character(len=64) :: d1_name
      logical :: needs_transpose

      ok = .false.
      ierr = nf90_open(trim(filename), nf90_nowrite, ncid)
      if (ierr /= nf90_noerr) return

      ! Chain queries through `ierr`: first failure short-circuits the
      ! rest; the file is closed once at the end (no early return).
      ierr = nf90_inq_varid(ncid, trim(t_var), varid)
      if (ierr == nf90_noerr) then
         ierr = nf90_inquire_variable(ncid, varid, ndims=var_ndims, dimids=var_dimids)
      end if
      if (ierr == nf90_noerr .and. var_ndims /= 3) ierr = -1
      if (ierr == nf90_noerr) then
         ierr = nf90_inquire_dimension(ncid, var_dimids(1), name=d1_name, len=d1_len)
      end if
      if (ierr == nf90_noerr) then
         ierr = nf90_inquire_dimension(ncid, var_dimids(2), len=d2_len)
      end if
      if (ierr == nf90_noerr) then
         ierr = nf90_inquire_dimension(ncid, var_dimids(3), len=d3_len)
      end if

      if (ierr == nf90_noerr) then
         needs_transpose = (trim(d1_name) == "z" .or. trim(d1_name) == "depth" .or. &
                            trim(d1_name) == "lev" .or. trim(d1_name) == "z_src")
         if (needs_transpose) then
            ok = (d3_len == nx_phys .and. d2_len == ny_phys)
         else
            ok = (d1_len == nx_phys .and. d2_len == ny_phys)
         end if
      end if

      ierr = nf90_close(ncid)
   end function zinit_dims_ok