ncdc_vars.F90

Go to the documentation of this file.

module ncdc_vars
    use ncd_kinds, only: i_long
    use ncdc_state, only: var_names, var_types, var_output_ids, &
        var_counters, var_hasunlim, var_dim_names, var_arr_total, &
        var_arr_size
    use ncdc_dims, only: dim_sizes, nc_diag_cat_lookup_dim
    use ncdc_realloc, only: nc_diag_realloc
    use ncdc_climsg, only: ncdc_error
    use netcdf, only: nf90_byte, nf90_short, nf90_int, nf90_float, &
        nf90_double, nf90_char
    
    implicit none
    
    integer(i_long), parameter                 :: var_start_size = 1024
    
    contains
        function nc_diag_cat_lookup_var(var_name) result(ind)
            character(len=*), intent(in)    :: var_name
            integer(i_long)                 :: i, ind
            
            ind = -1
            
            if (allocated(var_names)) then
                do i = 1, var_arr_total
                    if (var_names(i) == var_name) then
                        ind = i
                        exit
                    end if
                end do
            end if
        end function nc_diag_cat_lookup_var
        
        subroutine nc_diag_cat_metadata_add_var(var_name, var_type, var_ndims, var_dims)
            character(len=*), intent(in)    :: var_name
            integer(i_long) , intent(in)    :: var_type
            integer(i_long) , intent(in)    :: var_ndims
            character(len=*), intent(in)    :: var_dims(:)
            
            integer(i_long)                 :: var_index, i
            character(len=1000)             :: err_string
            
            var_index = nc_diag_cat_lookup_var(trim(var_name))
            
            ! If we can't find it, it's new! Make sure we have enough
            ! space for it...
            if (var_index == -1) then
#ifdef DEBUG
                print *, "NEW VAR! Var = " // trim(var_name)
#endif
                
                var_arr_total = var_arr_total + 1
                
                if (var_arr_total >= var_arr_size) then
                    if (allocated(var_names)) then
                        call nc_diag_realloc(var_names, var_start_size)
                        call nc_diag_realloc(var_types, var_start_size)
                        call nc_diag_realloc(var_dim_names, var_start_size)
                        call nc_diag_realloc(var_output_ids, var_start_size)
                        call nc_diag_realloc(var_counters, var_start_size)
                        call nc_diag_realloc(var_hasunlim, var_start_size)
                    else
                        allocate(var_names(var_start_size))
                        allocate(var_types(var_start_size))
                        allocate(var_dim_names(var_start_size))
                        allocate(var_output_ids(var_start_size))
                        allocate(var_counters(var_start_size))
                        allocate(var_hasunlim(var_start_size))
                        var_arr_size = var_start_size
                    end if
                end if
                
#ifdef DEBUG
                write (*, "(A)", advance="NO") "DEBUG DUMP:"
                
                do i = 1, var_arr_total - 1
                    if (i /= 1) write (*, "(A)", advance="NO") ", "
                    write (*, "(A)", advance="NO") var_names(i)
                end do
                
                print *, "NEW var_index: ", var_arr_total
#endif
                
                var_index = var_arr_total
                
                ! Add name
                var_names(var_index) = var_name
                var_types(var_index) = var_type
                var_counters(var_index) = 0
            end if
            
            if (allocated(var_dim_names(var_index)%dim_names)) then
                ! Just do a sanity check!
                if (var_types(var_index) /= var_type) &
                    call ncdc_error("Variable type changed!" // &
                        char(10) // "             " // &
                        "(Type of variable '" // var_name // "' changed from " // &
                        trim(nc_diag_cat_metadata_type_to_str(var_types(var_index))) // &
                        char(10) // "             " // &
                        "to " // &
                        trim(nc_diag_cat_metadata_type_to_str(var_type)) // &
                        "!)")
                
                if (var_dim_names(var_index)%num_names /= var_ndims) then
                    write (err_string, "(A, I0, A, I0, A)") &
                        "Variable ndims changed!" // &
                        char(10) // "             " // &
                        "(Variable '" // var_name // "' changed ndims from ", &
                        var_dim_names(var_index)%num_names, &
                        char(10) // "             " // &
                        "to ", &
                        var_ndims, &
                        "!)"
                    call ncdc_error(trim(err_string))
                end if
                
                do i = 1, var_ndims
                    if (var_dim_names(var_index)%dim_names(i) /= var_dims(i)) &
                        call ncdc_error("Variable dimensions changed!" // &
                        char(10) // "             " // &
                        "(Variable '" // var_name // "' changed dimension from " // &
                        trim(var_dim_names(var_index)%dim_names(i)) // &
                        char(10) // "             " // &
                        "to " // &
                        trim(var_dims(i)) // &
                        "!)")
                end do
            else
                var_dim_names(var_index)%num_names = var_ndims
                allocate(var_dim_names(var_index)%dim_names(var_ndims))
                allocate(var_dim_names(var_index)%output_dim_ids(var_ndims))
                var_dim_names(var_index)%dim_names(1:var_ndims) = var_dims(1:var_ndims)
                var_hasunlim(var_index) = .false.
                
                do i = 1, var_ndims
                    if (dim_sizes(nc_diag_cat_lookup_dim(var_dim_names(var_index)%dim_names(i))) == -1) then
                        var_hasunlim(var_index) = .true.
                        exit
                    end if
                end do
                
            end if
        end subroutine nc_diag_cat_metadata_add_var
        
        function nc_diag_cat_metadata_type_to_str(var_type) result(nc_str)
            integer(i_long)   :: var_type
            character(len=11) :: nc_str
            
            nc_str = "(invalid)"
            
            if (var_type == nf90_byte)   nc_str = "NF90_BYTE"
            if (var_type == nf90_short)  nc_str = "NF90_SHORT"
            if (var_type == nf90_int)    nc_str = "NF90_INT (LONG)"
            if (var_type == nf90_float)  nc_str = "NF90_FLOAT"
            if (var_type == nf90_double) nc_str = "NF90_DOUBLE"
            if (var_type == nf90_char)   nc_str = "NF90_CHAR"
        end function nc_diag_cat_metadata_type_to_str
end module ncdc_vars