From 6971065991a949f13bfb17d79717c08c8bc4abd7 Mon Sep 17 00:00:00 2001 From: Alper Altuntas Date: Mon, 7 Oct 2024 17:08:31 -0600 Subject: [PATCH] fix bugs in determining diag field kinds and fill values --- fms2_pio_io/fms_netcdf_domain_io.F90 | 2 +- fms2_pio_io/include/domain_write.inc | 164 +++++++++++++-------------- fms2_pio_io/netcdf_io.F90 | 1 + 3 files changed, 84 insertions(+), 83 deletions(-) diff --git a/fms2_pio_io/fms_netcdf_domain_io.F90 b/fms2_pio_io/fms_netcdf_domain_io.F90 index 8d8464539..b0fd1a180 100644 --- a/fms2_pio_io/fms_netcdf_domain_io.F90 +++ b/fms2_pio_io/fms_netcdf_domain_io.F90 @@ -1123,7 +1123,7 @@ function create_decomp(fileobj, variable_name, vdata_shape, basetype_nf, ndims, call PIO_initdecomp(pio_iosystem, basetype_nf, (/nig, njg, vdata_shape(3), vdata_shape(4) /), dof, decomp%iodesc) deallocate(dof) else - call error("Unsupported number of dimensions encountered in get_decomp.") + call error("Unsupported number of dimensions encountered in create_decomp.") endif end function create_decomp diff --git a/fms2_pio_io/include/domain_write.inc b/fms2_pio_io/include/domain_write.inc index f54a01918..ebe7e1a46 100644 --- a/fms2_pio_io/include/domain_write.inc +++ b/fms2_pio_io/include/domain_write.inc @@ -132,10 +132,9 @@ subroutine domain_write_2d(fileobj, variable_name, vdata, unlim_dim_level, & integer :: ydim_index integer :: ypos integer :: yc_size - integer(kind=i4_kind) :: fill_i4_kind !< Fill value of a i4_kind variable - integer(kind=i8_kind) :: fill_i8_kind !< Fill value of a i8_kind variable - real(kind=r4_kind) :: fill_r4_kind !< Fill value of a r4_kind variable - real(kind=r8_kind) :: fill_r8_kind !< Fill value of a r8_kind variable + integer(kind=i4_kind), allocatable :: fill_i4_kind !< Fill value of a i4_kind variable + real(kind=r4_kind), allocatable :: fill_r4_kind !< Fill value of a r4_kind variable + real(kind=r8_kind), allocatable :: fill_r8_kind !< Fill value of a r8_kind variable integer :: xgmax !< Ending x index of the global io domain integer :: xgmin !< Starting x index of the global io domain integer :: ygmax !< Ending y index of the global io domain @@ -154,45 +153,42 @@ subroutine domain_write_2d(fileobj, variable_name, vdata, unlim_dim_level, & return endif - select type(vdata) - type is (integer(kind=i4_kind)) - basetype_nf = PIO_INT - type is (real(kind=r4_kind)) - basetype_nf = PIO_REAL - type is (real(kind=r8_kind)) - basetype_nf = PIO_DOUBLE - class default - call error("unsupported variable type: domain_write_4d: file: "//trim(fileobj%path)//" variable:"// & - & trim(variable_name)) - end select - ! get varid and construct a temporary vardesc to pass to PIO routines varid = get_variable_id(fileobj%ncid, trim(variable_name), & - msg="file:"//trim(fileobj%path)//" and variable:"//trim(variable_name)) + msg="file:"//trim(fileobj%path)//" and variable:"//trim(variable_name)) vardesc%varID = varid vardesc%ncid = fileobj%ncid + ! Get the kind of the variable from PIO + basetype_nf = get_variable_type(fileobj%ncid, varid) + decomp => get_decomp(fileobj, variable_name, vardesc, shape(vdata), basetype_nf, 2, xdim_index, ydim_index, unlim_dim_level) err = 0 select type(vdata) type is (integer(kind=i4_kind)) - if (get_fill_value(fileobj, variable_name, fill_i4_kind, broadcast=.false.)) then - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_i4_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) - endif + allocate(fill_i4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_i4_kind, broadcast=.false.)) deallocate(fill_i4_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_i4_kind) type is (real(kind=r4_kind)) - if (get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) then + if (basetype_nf == pio_real) then + allocate(fill_r4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) deallocate(fill_r4_kind) call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_r4_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) + else ! basetype_nf == pio_double + allocate(fill_r8_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) deallocate(fill_r8_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, real(vdata, kind=r8_kind), err, fillval=fill_r8_kind) endif type is (real(kind=r8_kind)) - if (get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) then + if (basetype_nf == pio_real) then + allocate(fill_r4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) deallocate(fill_r4_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, real(vdata, kind=r4_kind), err, fillval=fill_r4_kind) + else ! basetype_nf == pio_double + allocate(fill_r8_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) deallocate(fill_r8_kind) call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_r8_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) endif class default call error("unsupported variable type: domain_write_4d: file: "//trim(fileobj%path)//" variable:"// & @@ -200,6 +196,10 @@ subroutine domain_write_2d(fileobj, variable_name, vdata, unlim_dim_level, & end select call check_netcdf_code(err, "domain_write.inc") + if (allocated(fill_i4_kind)) deallocate(fill_i4_kind) + if (allocated(fill_r4_kind)) deallocate(fill_r4_kind) + if (allocated(fill_r8_kind)) deallocate(fill_r8_kind) + end subroutine domain_write_2d @@ -255,10 +255,9 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & integer :: ydim_index integer :: ypos integer :: yc_size - integer(kind=i4_kind) :: fill_i4_kind !< Fill value of a i4_kind variable - integer(kind=i8_kind) :: fill_i8_kind !< Fill value of a i8_kind variable - real(kind=r4_kind) :: fill_r4_kind !< Fill value of a r4_kind variable - real(kind=r8_kind) :: fill_r8_kind !< Fill value of a r8_kind variable + integer(kind=i4_kind), allocatable :: fill_i4_kind !< Fill value of a i4_kind variable + real(kind=r4_kind), allocatable :: fill_r4_kind !< Fill value of a r4_kind variable + real(kind=r8_kind), allocatable :: fill_r8_kind !< Fill value of a r8_kind variable integer :: xgmax !< Ending x index of the global io domain integer :: xgmin !< Starting x index of the global io domain integer :: ygmax !< Ending y index of the global io domain @@ -277,45 +276,42 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & return endif - select type(vdata) - type is (integer(kind=i4_kind)) - basetype_nf = PIO_INT - type is (real(kind=r4_kind)) - basetype_nf = PIO_REAL - type is (real(kind=r8_kind)) - basetype_nf = PIO_DOUBLE - class default - call error("unsupported variable type: domain_write_4d: file: "//trim(fileobj%path)//" variable:"// & - & trim(variable_name)) - end select - ! get varid and construct a temporary vardesc to pass to PIO routines varid = get_variable_id(fileobj%ncid, trim(variable_name), & msg="file:"//trim(fileobj%path)//" and variable:"//trim(variable_name)) vardesc%varID = varid vardesc%ncid = fileobj%ncid + ! Get the kind of the variable from PIO + basetype_nf = get_variable_type(fileobj%ncid, varid) + decomp => get_decomp(fileobj, variable_name, vardesc, shape(vdata), basetype_nf, 3, xdim_index, ydim_index, unlim_dim_level) err = 0 select type(vdata) type is (integer(kind=i4_kind)) - if (get_fill_value(fileobj, variable_name, fill_i4_kind, broadcast=.false.)) then - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_i4_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) - endif + allocate(fill_i4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_i4_kind, broadcast=.false.)) deallocate(fill_i4_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_i4_kind) type is (real(kind=r4_kind)) - if (get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) then + if (basetype_nf == pio_real) then + allocate(fill_r4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) deallocate(fill_r4_kind) call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_r4_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) + else ! basetype_nf == pio_double + allocate(fill_r8_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) deallocate(fill_r8_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, real(vdata, kind=r8_kind), err, fillval=fill_r8_kind) endif type is (real(kind=r8_kind)) - if (get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) then + if (basetype_nf == pio_real) then + allocate(fill_r4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) deallocate(fill_r4_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, real(vdata, kind=r4_kind), err, fillval=fill_r4_kind) + else ! basetype_nf == pio_double + allocate(fill_r8_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) deallocate(fill_r8_kind) call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_r8_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) endif class default call error("unsupported variable type: domain_write_4d: file: "//trim(fileobj%path)//" variable:"// & @@ -323,6 +319,10 @@ subroutine domain_write_3d(fileobj, variable_name, vdata, unlim_dim_level, & end select call check_netcdf_code(err, "domain_write.inc") + if (allocated(fill_i4_kind)) deallocate(fill_i4_kind) + if (allocated(fill_r4_kind)) deallocate(fill_r4_kind) + if (allocated(fill_r8_kind)) deallocate(fill_r8_kind) + end subroutine domain_write_3d @@ -378,10 +378,9 @@ subroutine domain_write_4d(fileobj, variable_name, vdata, unlim_dim_level, & integer :: ydim_index integer :: ypos integer :: yc_size - integer(kind=i4_kind) :: fill_i4_kind !< Fill value of a i4_kind variable - integer(kind=i8_kind) :: fill_i8_kind !< Fill value of a i8_kind variable - real(kind=r4_kind) :: fill_r4_kind !< Fill value of a r4_kind variable - real(kind=r8_kind) :: fill_r8_kind !< Fill value of a r8_kind variable + integer(kind=i4_kind), allocatable :: fill_i4_kind !< Fill value of a i4_kind variable + real(kind=r4_kind), allocatable :: fill_r4_kind !< Fill value of a r4_kind variable + real(kind=r8_kind), allocatable :: fill_r8_kind !< Fill value of a r8_kind variable integer :: xgmax !< Ending x index of the global io domain integer :: xgmin !< Starting x index of the global io domain integer :: ygmax !< Ending y index of the global io domain @@ -415,43 +414,40 @@ subroutine domain_write_4d(fileobj, variable_name, vdata, unlim_dim_level, & endif - select type(vdata) - type is (integer(kind=i4_kind)) - basetype_nf = PIO_INT - type is (real(kind=r4_kind)) - basetype_nf = PIO_REAL - type is (real(kind=r8_kind)) - basetype_nf = PIO_DOUBLE - class default - call error("unsupported variable type: domain_write_4d: file: "//trim(fileobj%path)//" variable:"// & - & trim(variable_name)) - end select - ! set the members of temporary vardesc instance, which is passed when calling PIO_write_darray vardesc%varID = varid vardesc%ncid = fileobj%ncid + ! Get the kind of the variable from PIO + basetype_nf = get_variable_type(fileobj%ncid, varid) + decomp => get_decomp(fileobj, variable_name, vardesc, shape(vdata), basetype_nf, 4, xdim_index, ydim_index, unlim_dim_level) err = 0 select type(vdata) type is (integer(kind=i4_kind)) - if (get_fill_value(fileobj, variable_name, fill_i4_kind, broadcast=.false.)) then - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_i4_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) - endif + allocate(fill_i4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_i4_kind, broadcast=.false.)) deallocate(fill_i4_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_i4_kind) type is (real(kind=r4_kind)) - if (get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) then + if (basetype_nf == pio_real) then + allocate(fill_r4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) deallocate(fill_r4_kind) call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_r4_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) + else ! basetype_nf == pio_double + allocate(fill_r8_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) deallocate(fill_r8_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, real(vdata, kind=r8_kind), err, fillval=fill_r8_kind) endif type is (real(kind=r8_kind)) - if (get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) then + if (basetype_nf == pio_real) then + allocate(fill_r4_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r4_kind, broadcast=.false.)) deallocate(fill_r4_kind) + call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, real(vdata, kind=r4_kind), err, fillval=fill_r4_kind) + else ! basetype_nf == pio_double + allocate(fill_r8_kind) + if (.not. get_fill_value(fileobj, variable_name, fill_r8_kind, broadcast=.false.)) deallocate(fill_r8_kind) call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err, fillval=fill_r8_kind) - else - call PIO_write_darray(fileobj%file_desc, vardesc, decomp%iodesc, vdata, err) endif class default call error("unsupported variable type: domain_write_4d: file: "//trim(fileobj%path)//" variable:"// & @@ -459,6 +455,10 @@ subroutine domain_write_4d(fileobj, variable_name, vdata, unlim_dim_level, & end select call check_netcdf_code(err, "domain_write.inc") + if (allocated(fill_i4_kind)) deallocate(fill_i4_kind) + if (allocated(fill_r4_kind)) deallocate(fill_r4_kind) + if (allocated(fill_r8_kind)) deallocate(fill_r8_kind) + end subroutine domain_write_4d diff --git a/fms2_pio_io/netcdf_io.F90 b/fms2_pio_io/netcdf_io.F90 index 0806e2a60..0e5c031de 100644 --- a/fms2_pio_io/netcdf_io.F90 +++ b/fms2_pio_io/netcdf_io.F90 @@ -248,6 +248,7 @@ module netcdf_io_mod public :: get_variable_missing public :: get_variable_id public :: get_variable_units +public :: get_variable_type public :: get_time_calendar public :: is_registered_to_restart public :: set_netcdf_mode