diff --git a/src/mo_netcdf.f90 b/src/mo_netcdf.f90 index 003fd7330b99e0113668ff43f8662f69b2d52218..2826cd5735422f68c1f5d2a49af89fa5d4fe01bb 100644 --- a/src/mo_netcdf.f90 +++ b/src/mo_netcdf.f90 @@ -30,13 +30,13 @@ module mo_netcdf use netcdf, only : & nf90_open, nf90_close, nf90_strerror, nf90_def_dim, nf90_def_var, & - nf90_put_var, nf90_get_var, nf90_put_att, nf90_get_att, & + nf90_put_var, nf90_get_var, nf90_put_att, nf90_get_att, nf90_inq_attname, & nf90_inquire, nf90_inq_dimid, nf90_inquire_dimension, & nf90_inq_varid, nf90_inq_varids, nf90_inquire_variable, nf90_inquire_attribute, & nf90_inq_ncid, nf90_inq_grp_parent, nf90_inq_grpname, nf90_def_grp, & nf90_rename_dim, nf90_rename_var, nf90_rename_att, nf90_sync, & NF90_OPEN, NF90_NETCDF4, NF90_CREATE, NF90_WRITE, NF90_NOWRITE, & - NF90_BYTE, NF90_SHORT, NF90_INT, NF90_INT64, NF90_FLOAT, NF90_DOUBLE, & + NF90_BYTE, NF90_SHORT, NF90_INT, NF90_INT64, NF90_FLOAT, NF90_DOUBLE, NF90_CHAR, & NF90_FILL_BYTE, NF90_FILL_SHORT, NF90_FILL_INT, NF90_FILL_FLOAT, NF90_FILL_DOUBLE, & NF90_NOERR, NF90_UNLIMITED, NF90_GLOBAL, NF90_SHARE, NF90_HDF5, & NF90_64BIT_OFFSET, NF90_CLASSIC_MODEL @@ -72,6 +72,7 @@ module mo_netcdf procedure, public :: hasAttribute procedure, public :: renameAttribute procedure, private :: getAttributableIds + procedure, public :: getAttributeNames procedure, private :: setAttribute_0d_sp generic, public :: setAttribute => setAttribute_0d_sp @@ -1060,21 +1061,54 @@ contains end do end function isUnlimitedVariable - logical function hasAttribute(self, name) + logical function hasAttribute(self, name, xtype, len, attnum) class(NcAttributable), intent(in) :: self character(*), intent(in) :: name + integer(i4), intent(out), optional :: xtype + integer(i4), intent(out), optional :: len + integer(i4), intent(out), optional :: attnum integer(i4) :: status select type (self) class is (NcGroup) - status = nf90_inquire_attribute(self%id, NF90_GLOBAL, name) + status = nf90_inquire_attribute(self%id, NF90_GLOBAL, name, xtype=xtype, len=len, attnum=attnum) class is (NcVariable) - status = nf90_inquire_attribute(self%parent%id, self%id, name) + status = nf90_inquire_attribute(self%parent%id, self%id, name, xtype=xtype, len=len, attnum=attnum) end select hasAttribute = (status == NF90_NOERR) end function hasAttribute + function getAttributeNames(self) result(attributeNames) + class(NcAttributable), intent(in) :: self + character(256), dimension(:), allocatable :: attributeNames + + integer(i4), parameter :: maxNames = 100_i4 + integer(i4) :: nAtts + integer(i4) :: status + + ! assume a maximum number of 100 attributes that are checked + allocate(attributeNames(maxNames)) + nAtts = 0_i4 + do while (nAtts < maxNames) + select type (self) + class is (NcGroup) + status = nf90_inq_attname(self%id, NF90_GLOBAL, nAtts + 1_i4, attributeNames(nAtts + 1_i4)) + class is (NcVariable) + status = nf90_inq_attname(self%parent%id, self%id, nAtts + 1_i4, attributeNames(nAtts + 1_i4)) + end select + ! if the status is negative, exit loop, else increase counter + if (status /= NF90_NOERR) then + exit + else + nAtts = nAtts + 1_i4 + end if + end do + ! select only valid names + attributeNames = attributeNames(1:nAtts) + + end function getAttributeNames + subroutine setAttribute_0d_sp(self, name, data) @@ -3574,6 +3608,8 @@ contains getDtypeFromString = NF90_INT case("i64") getDtypeFromString = NF90_INT64 + case("char") + getDtypeFromString = NF90_CHAR case default write(*,*) "Datatype not understood: ", dtype stop 1 @@ -3597,6 +3633,8 @@ contains getDtypeFromInteger = "i32" case(NF90_INT64) getDtypeFromInteger = "i64" + case(NF90_CHAR) + getDtypeFromInteger = "char" case default write(*,*) "Datatype not understood: ", dtype stop 1 diff --git a/src/mo_netcdf.fypp b/src/mo_netcdf.fypp index 5cf3d7d6368138eb648e47b39922fa786a15076c..8410b775d4eb70d3531f2c113fb1fb45411d2e3d 100644 --- a/src/mo_netcdf.fypp +++ b/src/mo_netcdf.fypp @@ -34,13 +34,13 @@ module mo_netcdf use netcdf, only : & nf90_open, nf90_close, nf90_strerror, nf90_def_dim, nf90_def_var, & - nf90_put_var, nf90_get_var, nf90_put_att, nf90_get_att, & + nf90_put_var, nf90_get_var, nf90_put_att, nf90_get_att, nf90_inq_attname, & nf90_inquire, nf90_inq_dimid, nf90_inquire_dimension, & nf90_inq_varid, nf90_inq_varids, nf90_inquire_variable, nf90_inquire_attribute, & nf90_inq_ncid, nf90_inq_grp_parent, nf90_inq_grpname, nf90_def_grp, & nf90_rename_dim, nf90_rename_var, nf90_rename_att, nf90_sync, & NF90_OPEN, NF90_NETCDF4, NF90_CREATE, NF90_WRITE, NF90_NOWRITE, & - NF90_BYTE, NF90_SHORT, NF90_INT, NF90_INT64, NF90_FLOAT, NF90_DOUBLE, & + NF90_BYTE, NF90_SHORT, NF90_INT, NF90_INT64, NF90_FLOAT, NF90_DOUBLE, NF90_CHAR, & NF90_FILL_BYTE, NF90_FILL_SHORT, NF90_FILL_INT, NF90_FILL_FLOAT, NF90_FILL_DOUBLE, & NF90_NOERR, NF90_UNLIMITED, NF90_GLOBAL, NF90_SHARE, NF90_HDF5, & NF90_64BIT_OFFSET, NF90_CLASSIC_MODEL @@ -76,6 +76,7 @@ module mo_netcdf procedure, public :: hasAttribute procedure, public :: renameAttribute procedure, private :: getAttributableIds + procedure, public :: getAttributeNames #:for kind, type in REAL_KINDS_TYPES + INT_KINDS_TYPES #:for rank in [0, 1] @@ -838,21 +839,54 @@ contains end do end function isUnlimitedVariable - logical function hasAttribute(self, name) + logical function hasAttribute(self, name, xtype, len, attnum) class(NcAttributable), intent(in) :: self character(*), intent(in) :: name + integer(i4), intent(out), optional :: xtype + integer(i4), intent(out), optional :: len + integer(i4), intent(out), optional :: attnum integer(i4) :: status select type (self) class is (NcGroup) - status = nf90_inquire_attribute(self%id, NF90_GLOBAL, name) + status = nf90_inquire_attribute(self%id, NF90_GLOBAL, name, xtype=xtype, len=len, attnum=attnum) class is (NcVariable) - status = nf90_inquire_attribute(self%parent%id, self%id, name) + status = nf90_inquire_attribute(self%parent%id, self%id, name, xtype=xtype, len=len, attnum=attnum) end select hasAttribute = (status == NF90_NOERR) end function hasAttribute + function getAttributeNames(self) result(attributeNames) + class(NcAttributable), intent(in) :: self + character(256), dimension(:), allocatable :: attributeNames + + integer(i4), parameter :: maxNames = 100_i4 + integer(i4) :: nAtts + integer(i4) :: status + + ! assume a maximum number of 100 attributes that are checked + allocate(attributeNames(maxNames)) + nAtts = 0_i4 + do while (nAtts < maxNames) + select type (self) + class is (NcGroup) + status = nf90_inq_attname(self%id, NF90_GLOBAL, nAtts + 1_i4, attributeNames(nAtts + 1_i4)) + class is (NcVariable) + status = nf90_inq_attname(self%parent%id, self%id, nAtts + 1_i4, attributeNames(nAtts + 1_i4)) + end select + ! if the status is negative, exit loop, else increase counter + if (status /= NF90_NOERR) then + exit + else + nAtts = nAtts + 1_i4 + end if + end do + ! select only valid names + attributeNames = attributeNames(1:nAtts) + + end function getAttributeNames + #:def setAttribute_template(kind, type, rank) subroutine setAttribute_${rank}$d_${kind}$(self, name, data) class(NcAttributable), intent(in) :: self @@ -1140,6 +1174,8 @@ $: ' allocate(mask(' + ('datashape({}), '*rank).format(*list(range(1, rank+ getDtypeFromString = NF90_INT case("i64") getDtypeFromString = NF90_INT64 + case("char") + getDtypeFromString = NF90_CHAR case default write(*,*) "Datatype not understood: ", dtype stop 1 @@ -1163,6 +1199,8 @@ $: ' allocate(mask(' + ('datashape({}), '*rank).format(*list(range(1, rank+ getDtypeFromInteger = "i32" case(NF90_INT64) getDtypeFromInteger = "i64" + case(NF90_CHAR) + getDtypeFromInteger = "char" case default write(*,*) "Datatype not understood: ", dtype stop 1 diff --git a/src/pf_tests/test_mo_netcdf.pf b/src/pf_tests/test_mo_netcdf.pf index d36efba8bb9caaf31f7d3950ce0cdac6df048196..9f520ba18262e92e60b6bf6e680d661e09acff71 100644 --- a/src/pf_tests/test_mo_netcdf.pf +++ b/src/pf_tests/test_mo_netcdf.pf @@ -13,6 +13,15 @@ module test_mo_netcdf character(*), parameter :: fname="netcdf_make_check_test_file" character(*), parameter :: vname_time="time", vname_lat="lat", vname_lon="lon", vname_data="data" + character(64), dimension(3), parameter :: waglobalnames = [character(64) :: 'Author', 'Year', 'intentionally_fail'] + ! see netcdf-fortran repo: /fortran/netcdf_constants.f90 + logical, dimension(3), parameter :: wahasatt = [.true., .true., .false.] + integer(i4), dimension(3), parameter :: waglobaltype = [2_i4, 4_i4, -1_i4] + integer(i4), dimension(3), parameter :: wagloballen = [64_i4, 1_i4, -1_i4] + integer(i4), dimension(3) :: raglobaltype, ragloballen, raglobalnum + logical, dimension(3) :: rahasatt + character(64), dimension(2), parameter :: wavarnames = [character(64) :: 'units', 'scaling'] + character(64), dimension(:), allocatable :: raglobalnames, ravarnames character(64) :: wavalue, ravalue type(NcDataset) :: nc @@ -72,6 +81,10 @@ contains ! add some variable attributes call var_time%setAttribute("units", "days since 1989-12-31 12:00:00") + ! add some variable attributes + call var_data%setAttribute(trim(wavarnames(1)), "mm/d") + call var_data%setAttribute(trim(wavarnames(2)), 0.1_dp) + ! set fill value before any data is written call var_data%setFillValue(wfvalue) @@ -85,13 +98,9 @@ contains call var_data%setData(wdata(:,:,i), start=(/1,1,i/)) end do - ! add some more variable attributes - call var_data%setAttribute("units", "mm/d") - call var_data%setAttribute("scaling", 0.1_dp) - ! add global attributes - call nc%setAttribute("Author", wavalue) - call nc%setAttribute("Year", 2099_i4) + call nc%setAttribute(trim(waglobalnames(1)), wavalue) + call nc%setAttribute(trim(waglobalnames(2)), 2099_i4) ! close the file call nc%close() @@ -114,23 +123,42 @@ contains call var_lon%getData(rlon) call var_data%getData(rdata) + ravarnames = var_data%getAttributeNames() + ! read the fill value call var_data%getFillValue(rfvalue) ! read a global attribute - call nc%getAttribute("Author", ravalue) + raglobalnames = nc%getAttributeNames() + + rahasatt(1) = nc%hasAttribute(name=waglobalnames(1), xtype=raglobaltype(1), len=ragloballen(1)) + rahasatt(2) = nc%hasAttribute(name=waglobalnames(2), xtype=raglobaltype(2), len=ragloballen(2)) + rahasatt(3) = nc%hasAttribute(name=waglobalnames(3), xtype=raglobaltype(3), len=ragloballen(3)) + + call nc%getAttribute(trim(waglobalnames(1)), ravalue) ! close dataset call nc%close() ! 1.3 Check ! --------- - @assertEqual(rtime, wtime(1:ntime)) - @assertEqual(rlat, wlat) - @assertEqual(rlon, wlon) - @assertEqual(rdata, wdata(:,:,1:ntime)) + @assertEqual(wtime(1:ntime), rtime) + @assertEqual(wlat, rlat) + @assertEqual(wlon, rlon) + @assertEqual(wdata(:,:,1:ntime), rdata) @assertEqual(rfvalue, rfvalue) - @assertEqual(ravalue, wavalue) + @assertEqual(wavalue, ravalue) + do i=1, size(wavarnames) + @assertEqual(wavarnames(i), ravarnames(i)) + end do + do i=1, size(waglobalnames) + @assertEqual(wahasatt(i), rahasatt(i)) + if (rahasatt(i)) then + @assertEqual(waglobalnames(i), raglobalnames(i)) + @assertEqual(waglobaltype(i), raglobaltype(i)) + @assertEqual(wagloballen(i), ragloballen(i)) + end if + end do end subroutine test_netcdf_create_new @@ -179,8 +207,8 @@ contains ! 2.3 Check ! --------- - @assertEqual(rtime(1:nadd), wtime(ntime+1:ntime+nadd)) - @assertEqual(rdata(:,:,1:nadd), wdata(:,:,ntime+1:ntime+nadd)) + @assertEqual(wtime(ntime+1:ntime+nadd), rtime(1:nadd)) + @assertEqual(wdata(:,:,ntime+1:ntime+nadd), rdata(:,:,1:nadd)) end subroutine test_netcdf_append @@ -249,8 +277,8 @@ contains ! 3.3 check ! --------- - @assertEqual(rtime, wtime) - @assertEqual(rdata, wdata) + @assertEqual(wtime, rtime) + @assertEqual(wdata, rdata) end subroutine test_netcdf_dump