ncdw_varattr.F90

Go to the documentation of this file.

module ncdw_varattr
    use ncd_kinds, only: i_byte, i_short, i_long, i_llong, r_single, &
        r_double
    use ncdw_state, only: init_done, append_only, ncid, &
        diag_varattr_store
    use ncdw_types, only: nlayer_default_ent
    use ncdw_climsg, only: nclayer_error, nclayer_warning, &
        nclayer_check
    use ncdw_realloc, only: nc_diag_realloc
    use netcdf, only: nf90_inq_dimid, nf90_def_dim, nf90_put_att, &
        nf90_unlimited
    
    implicit none
    
    interface nc_diag_varattr
        module procedure nc_diag_varattr_byte, &
            nc_diag_varattr_short, nc_diag_varattr_long, &
            nc_diag_varattr_rsingle, nc_diag_varattr_rdouble, &
            nc_diag_varattr_string, &
            nc_diag_varattr_byte_v, nc_diag_varattr_short_v, &
            nc_diag_varattr_long_v, nc_diag_varattr_rsingle_v, &
            nc_diag_varattr_rdouble_v
    end interface nc_diag_varattr
    
    contains
        function nc_diag_varattr_check_var(var_name) result(found)
            character(len=*), intent(in)    :: var_name
            integer :: i
            logical :: found
            found = .false.
            
            if (init_done .AND. allocated(diag_varattr_store)) then
                do i = 1, diag_varattr_store%total
                    if (diag_varattr_store%names(i) == var_name) then
                        found = .true.
                        exit
                    end if
                end do
            end if
        end function nc_diag_varattr_check_var
        
        function nc_diag_varattr_lookup_var(var_name) result(ind)
            character(len=*), intent(in)    :: var_name
            integer :: i, ind
            
            ind = -1
            
            if (init_done .AND. allocated(diag_varattr_store)) then
                do i = 1, diag_varattr_store%total
                    if (diag_varattr_store%names(i) == var_name) then
                        ind = i
                        exit
                    end if
                end do
            end if
        end function nc_diag_varattr_lookup_var
        
        subroutine nc_diag_varattr_make_nobs_dim
            if (init_done .AND. allocated(diag_varattr_store)) then
                if (diag_varattr_store%nobs_dim_id == -1) then
                    if (append_only) then
                        ! Fetch the nobs dimension ID instead!
                        call nclayer_check(nf90_inq_dimid(ncid, "nobs", diag_varattr_store%nobs_dim_id))
                    else
                        call nclayer_check(nf90_def_dim(ncid, "nobs", nf90_unlimited, diag_varattr_store%nobs_dim_id))
                    end if
                end if
            else
                call nclayer_error("NetCDF4 layer not initialized yet!")
            end if
        end subroutine nc_diag_varattr_make_nobs_dim
        
        subroutine nc_diag_varattr_expand(addl_fields)
            integer(i_llong), intent(in) :: addl_fields
            integer(i_llong)             :: size_add
            
            if (init_done .AND. allocated(diag_varattr_store)) then
                if (allocated(diag_varattr_store%names)) then
                    if (diag_varattr_store%total >= size(diag_varattr_store%names)) then
                        size_add = (size(diag_varattr_store%names) * 0.5) + addl_fields
                        call nc_diag_realloc(diag_varattr_store%names, addl_fields)
                    end if
                else
                    allocate(diag_varattr_store%names(nlayer_default_ent))
                end if
                
                if (allocated(diag_varattr_store%types)) then
                    if (diag_varattr_store%total >= size(diag_varattr_store%types)) then
                        size_add = (size(diag_varattr_store%types) * 0.5) + addl_fields
                        call nc_diag_realloc(diag_varattr_store%types, size_add)
                    end if
                else
                    allocate(diag_varattr_store%types(nlayer_default_ent))
                    diag_varattr_store%types = -1
                end if
                
                if (allocated(diag_varattr_store%var_ids)) then
                    if (diag_varattr_store%total >= size(diag_varattr_store%var_ids)) then
                        size_add = (size(diag_varattr_store%var_ids) * 0.5) + addl_fields
                        call nc_diag_realloc(diag_varattr_store%var_ids, size_add)
                    end if
                else
                    allocate(diag_varattr_store%var_ids(nlayer_default_ent))
                    diag_varattr_store%var_ids = -1
                end if
                
            else
                call nclayer_error("NetCDF4 layer not initialized yet!")
            endif
            
        end subroutine nc_diag_varattr_expand
        
        subroutine nc_diag_varattr_add_var(var_name, var_type, var_id)
            character(len=*), intent(in)    :: var_name
            integer(i_byte),  intent(in)    :: var_type
            integer(i_long)                 :: var_id
            
            if (nc_diag_varattr_check_var(var_name)) then
                call nclayer_error("Variable already exists for variable attributes!")
            else
#ifdef _DEBUG_MEM_
                print *, "adding var!"
#endif
                call nc_diag_varattr_expand(1_i_llong)
                diag_varattr_store%total = diag_varattr_store%total + 1
                diag_varattr_store%names(diag_varattr_store%total) = var_name
                diag_varattr_store%types(diag_varattr_store%total) = var_type
                diag_varattr_store%var_ids(diag_varattr_store%total) = var_id
#ifdef _DEBUG_MEM_
                print *, "done adding var!"
#endif
            end if
        end subroutine nc_diag_varattr_add_var
        
        ! nc_diag_varattr - input integer(i_byte)
        ! Corresponding NetCDF4 type: byte
        subroutine nc_diag_varattr_byte(var_name, attr_name, attr_value)
            character(len=*), intent(in)    :: var_name
            character(len=*), intent(in)    :: attr_name
            integer(i_byte), intent(in)     :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_byte
        
        ! nc_diag_varattr - input integer(i_short)
        ! Corresponding NetCDF4 type: short
        subroutine nc_diag_varattr_short(var_name, attr_name, attr_value)
            character(len=*), intent(in)    :: var_name
            character(len=*), intent(in)    :: attr_name
            integer(i_short), intent(in)    :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_short
        
        ! nc_diag_varattr - input integer(i_long)
        ! Corresponding NetCDF4 type: int (old: long)
        subroutine nc_diag_varattr_long(var_name, attr_name, attr_value)
            character(len=*), intent(in)    :: var_name
            character(len=*), intent(in)    :: attr_name
            integer(i_long), intent(in)     :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_long
        
        ! nc_diag_varattr - input real(r_single)
        ! Corresponding NetCDF4 type: float (or real)
        subroutine nc_diag_varattr_rsingle(var_name, attr_name, attr_value)
            character(len=*), intent(in)    :: var_name
            character(len=*), intent(in)    :: attr_name
            real(r_single), intent(in)      :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_rsingle
        
        ! nc_diag_varattr - input real(r_double)
        ! Corresponding NetCDF4 type: double
        subroutine nc_diag_varattr_rdouble(var_name, attr_name, attr_value)
            character(len=*), intent(in)    :: var_name
            character(len=*), intent(in)    :: attr_name
            real(r_double), intent(in)      :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_rdouble

        ! nc_diag_varattr - input character(len=*)
        ! Corresponding NetCDF4 type: string? char?
        subroutine nc_diag_varattr_string(var_name, attr_name, attr_value)
            character(len=*), intent(in)    :: var_name
            character(len=*), intent(in)    :: attr_name
            character(len=*), intent(in)    :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_string
        
        !=============================================================
        ! VECTOR TYPES
        !=============================================================
        
        ! nc_diag_varattr - input integer(i_byte), dimension(:)
        ! Corresponding NetCDF4 type: byte
        subroutine nc_diag_varattr_byte_v(var_name, attr_name, attr_value)
            character(len=*), intent(in)               :: var_name
            character(len=*), intent(in)               :: attr_name
            integer(i_byte), dimension(:), intent(in)  :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_byte_v
        
        ! nc_diag_varattr - input integer(i_short)
        ! Corresponding NetCDF4 type: short
        subroutine nc_diag_varattr_short_v(var_name, attr_name, attr_value)
            character(len=*), intent(in)               :: var_name
            character(len=*), intent(in)               :: attr_name
            integer(i_short), dimension(:), intent(in) :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_short_v
        
        ! nc_diag_varattr - input integer(i_long)
        ! Corresponding NetCDF4 type: int (old: long)
        subroutine nc_diag_varattr_long_v(var_name, attr_name, attr_value)
            character(len=*), intent(in)               :: var_name
            character(len=*), intent(in)               :: attr_name
            integer(i_long), dimension(:), intent(in)  :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_long_v
        
        ! nc_diag_varattr - input real(r_single)
        ! Corresponding NetCDF4 type: float (or real)
        subroutine nc_diag_varattr_rsingle_v(var_name, attr_name, attr_value)
            character(len=*), intent(in)               :: var_name
            character(len=*), intent(in)               :: attr_name
            real(r_single), dimension(:), intent(in)   :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_rsingle_v
        
        ! nc_diag_varattr - input real(r_double)
        ! Corresponding NetCDF4 type: double
        subroutine nc_diag_varattr_rdouble_v(var_name, attr_name, attr_value)
            character(len=*), intent(in)               :: var_name
            character(len=*), intent(in)               :: attr_name
            real(r_double), dimension(:), intent(in)   :: attr_value
            
            integer(i_long)                 :: var_index
            
            if (nc_diag_varattr_check_var(var_name)) then
                var_index = nc_diag_varattr_lookup_var(var_name)
                if (var_index == -1) call nclayer_error("Bug! Variable exists but could not lookup index for attr!")
                call nclayer_check(nf90_put_att(ncid, diag_varattr_store%var_ids(var_index), attr_name, attr_value))
            else
                call nclayer_error("Can't set attribute for a non-existent variable!" &
                    // char(10) &
                    // "             (If you did add the variable, make sure you lock" &
                    // char(10) &
                    // "             the definitions before calling varattr!) ")
            end if
        end subroutine nc_diag_varattr_rdouble_v
end module ncdw_varattr