tkr-distinct write scalar prototype

Author: scivision

src/interface.f90

@@ -40,12 +40,15 @@ module nc4fortran
   is_chunked, is_contig, chunks=>get_chunk
 
 !> generic procedures mapped over type / rank
-generic, public :: write => nc_write_scalar, nc_write_1d, nc_write_2d, nc_write_3d, &
+generic, public :: write => &
+  nc_write_scalar_r32, nc_write_scalar_r64, nc_write_scalar_i32, nc_write_scalar_i64, nc_write_scalar_char, &
+  nc_write_1d, nc_write_2d, nc_write_3d, &
   nc_write_4d, nc_write_5d, nc_write_6d, nc_write_7d
 
 generic, public :: read => nc_read_scalar, nc_read_1d, nc_read_2d, nc_read_3d, nc_read_4d, nc_read_5d, nc_read_6d, nc_read_7d
 
-procedure, private :: nc_write_scalar, nc_write_1d, nc_write_2d, nc_write_3d, nc_write_4d, nc_write_5d, nc_write_6d, nc_write_7d, &
+procedure, private :: nc_write_scalar_r32, nc_write_scalar_r64, nc_write_scalar_i32, nc_write_scalar_i64, nc_write_scalar_char, &
+  nc_write_1d, nc_write_2d, nc_write_3d, nc_write_4d, nc_write_5d, nc_write_6d, nc_write_7d, &
   nc_read_scalar, nc_read_1d, nc_read_2d, nc_read_3d, nc_read_4d, nc_read_5d, nc_read_6d, nc_read_7d, &
   def_dims
 
@@ -69,12 +72,40 @@ module function get_tempdir()
 end interface
 
 interface !< writer.f90
-module subroutine nc_write_scalar(self, dname, value, ierr)
+module subroutine nc_write_scalar_char(self, dname, value, ierr)
 class(netcdf_file), intent(in) :: self
 character(*), intent(in) :: dname
-class(*), intent(in) :: value
+character(*), intent(in) :: value
+integer, intent(out), optional :: ierr
+end subroutine nc_write_scalar_char
+
+module subroutine nc_write_scalar_r32(self, dname, value, ierr)
+class(netcdf_file), intent(in) :: self
+character(*), intent(in) :: dname
+real(real32), intent(in) :: value
+integer, intent(out), optional :: ierr
+end subroutine nc_write_scalar_r32
+
+module subroutine nc_write_scalar_r64(self, dname, value, ierr)
+class(netcdf_file), intent(in) :: self
+character(*), intent(in) :: dname
+real(real64), intent(in) :: value
+integer, intent(out), optional :: ierr
+end subroutine nc_write_scalar_r64
+
+module subroutine nc_write_scalar_i32(self, dname, value, ierr)
+class(netcdf_file), intent(in) :: self
+character(*), intent(in) :: dname
+integer(int32), intent(in) :: value
+integer, intent(out), optional :: ierr
+end subroutine nc_write_scalar_i32
+
+module subroutine nc_write_scalar_i64(self, dname, value, ierr)
+class(netcdf_file), intent(in) :: self
+character(*), intent(in) :: dname
+integer(int64), intent(in) :: value
 integer, intent(out), optional :: ierr
-end subroutine nc_write_scalar
+end subroutine nc_write_scalar_i64
 
 module subroutine nc_write_1d(self, dname, value, dims, ierr)
 class(netcdf_file), intent(in) :: self

src/tests/test_error.f90

@@ -14,8 +14,6 @@ program test_errors
 print *, 'OK: non-existing variable'
 call test_wrong_type()
 print *, "OK: wrong type read"
-call test_unknown_write()
-print *, 'OK: unknown write'
 call test_unknown_read()
 print *, 'OK: unknown read'
 
@@ -83,20 +81,6 @@ subroutine test_wrong_type()
 end subroutine test_wrong_type
 
 
-subroutine test_unknown_write()
-integer :: ierr
-type(netcdf_file) :: h
-character(*), parameter :: filename = 'bad.nc'
-complex :: x
-
-x = (1, -1)
-
-call h%initialize(filename, ierr, status='replace')
-call h%write('/complex', x, ierr)
-if(ierr==NF90_NOERR) error stop 'test_unknown_write: writing unknown type variable'
-end subroutine test_unknown_write
-
-
 subroutine test_unknown_read()
 integer :: ierr
 type(netcdf_file) :: h

src/writer.in.f90

@@ -7,62 +7,98 @@
 
 contains
 
-module procedure nc_write_scalar
-integer :: varid, ier
+module procedure nc_write_scalar_char
+integer :: varid, ier, lenid
 
 if(.not.self%is_open) error stop 'ERROR:nc4fortran:writer: file handle not open'
 
-ier = NF90_NOERR
+!! uses string prefill method
+!! https://www.unidata.ucar.edu/software/netcdf/docs-fortran/f90-variables.html#f90-reading-and-writing-character-string-values
+
+ier = nf90_def_dim(self%ncid, dname // "StrLen", len(value) + 1, lenid)
+if(ier == NF90_NOERR) ier = nf90_def_var(self%ncid, dname, NF90_CHAR, dimids=lenid, varid=varid)
+
+if(ier == NF90_NOERR) ier = nf90_enddef(self%ncid)  !< prefill
+if(ier == NF90_NOERR) ier = nf90_put_var(self%ncid, varid, value)
+
+if (present(ierr)) ierr = ier
+if (check_error(ier, dname) .and. .not. present(ierr)) error stop 'nc4fortran:write could not write ' // dname
+
+end procedure nc_write_scalar_char
+
+module procedure nc_write_scalar_r32
+integer :: varid, ier
+
+if(.not.self%is_open) error stop 'nc4fortran:write: file handle not open for ' // dname
 
 if (self%exist(dname)) then
   ier = nf90_inq_varid(self%ncid, dname, varid)
 else
-  select type (value)
-  type is (real(real64))
-    ier = nf90_def_var(self%ncid, dname, NF90_DOUBLE, varid=varid)
-  type is (real(real32))
-    ier = nf90_def_var(self%ncid, dname, NF90_FLOAT, varid=varid)
-  type is (integer(int32))
-    ier = nf90_def_var(self%ncid, dname, NF90_INT, varid=varid)
-  type is (integer(int64))
-    ier = nf90_def_var(self%ncid, dname, NF90_INT64, varid=varid)
-  end select
+  ier = nf90_def_var(self%ncid, dname, NF90_FLOAT, varid=varid)
 endif
 
-if(ier/=NF90_NOERR) write(stderr,*) 'ERROR:nc4fortran:writer:scalar: problem getting varid'
-
-if(ier == NF90_NOERR) then
-  select type (value)
-  type is (character(*))
-    !! uses string prefill method
-    !! https://www.unidata.ucar.edu/software/netcdf/docs-fortran/f90-variables.html#f90-reading-and-writing-character-string-values
-    block
-      integer :: lenid
-      ier = nf90_def_dim(self%ncid, dname // "StrLen", len(value) + 1, lenid)
-      if(ier == NF90_NOERR) ier = nf90_def_var(self%ncid, dname, NF90_CHAR, dimids=lenid, varid=varid)
-    end block
-    if(ier == NF90_NOERR) ier = nf90_enddef(self%ncid)  !< prefill
-    if(ier == NF90_NOERR) ier = nf90_put_var(self%ncid, varid, value)
-  type is (real(real64))
-    ier = nf90_put_var(self%ncid, varid, value)
-  type is (real(real32))
-    ier = nf90_put_var(self%ncid, varid, value)
-  type is (integer(int32))
-    ier = nf90_put_var(self%ncid, varid, value)
-  type is (integer(int64))
-    ier = nf90_put_var(self%ncid, varid, value)
-  class default
-    ier = NF90_EBADTYPE
-  end select
+if(ier == NF90_NOERR) ier = nf90_put_var(self%ncid, varid, value)
+
+if (present(ierr)) ierr = ier
+if (check_error(ier, dname) .and. .not. present(ierr)) error stop 'nc4fortran:write: could not write ' // dname
+
+end procedure nc_write_scalar_r32
+
+module procedure nc_write_scalar_r64
+integer :: varid, ier
+
+if(.not.self%is_open) error stop 'nc4fortran:write: file handle not open for ' // dname
+
+if (self%exist(dname)) then
+  ier = nf90_inq_varid(self%ncid, dname, varid)
+else
+  ier = nf90_def_var(self%ncid, dname, NF90_DOUBLE, varid=varid)
 endif
 
+if(ier == NF90_NOERR) ier = nf90_put_var(self%ncid, varid, value)
+
 if (present(ierr)) ierr = ier
-if (check_error(ier, dname)) then
-  if (present(ierr)) return
-  error stop
+if (check_error(ier, dname) .and. .not. present(ierr)) error stop 'nc4fortran:write: could not write ' // dname
+
+end procedure nc_write_scalar_r64
+
+
+module procedure nc_write_scalar_i32
+integer :: varid, ier
+
+if(.not.self%is_open) error stop 'nc4fortran:write: file handle not open for ' // dname
+
+if (self%exist(dname)) then
+  ier = nf90_inq_varid(self%ncid, dname, varid)
+else
+  ier = nf90_def_var(self%ncid, dname, NF90_INT, varid=varid)
+endif
+
+if(ier == NF90_NOERR) ier = nf90_put_var(self%ncid, varid, value)
+
+if (present(ierr)) ierr = ier
+if (check_error(ier, dname) .and. .not. present(ierr)) error stop 'nc4fortran:write: could not write ' // dname
+
+end procedure nc_write_scalar_i32
+
+
+module procedure nc_write_scalar_i64
+integer :: varid, ier
+
+if(.not.self%is_open) error stop 'nc4fortran:write: file handle not open for ' // dname
+
+if (self%exist(dname)) then
+  ier = nf90_inq_varid(self%ncid, dname, varid)
+else
+  ier = nf90_def_var(self%ncid, dname, NF90_INT64, varid=varid)
 endif
 
-end procedure nc_write_scalar
+if(ier == NF90_NOERR) ier = nf90_put_var(self%ncid, varid, value)
+
+if (present(ierr)) ierr = ier
+if (check_error(ier, dname) .and. .not. present(ierr)) error stop 'nc4fortran:write: could not write ' // dname
+
+end procedure nc_write_scalar_i64
 
 
 module procedure nc_write_1d