function triangulation_boundary_nodes ( prefix ) %*****************************************************************************80 % %% MAIN is the main program for TRIANGULATION_BOUNDARY_NODES. % % Discussion: % % TRIANGULATION_BOUNDARY_NODES outputs boundary nodes of a triangulation. % % Each connected segment of the boundary is written to a separate file. % % Usage: % % triangulation_boundary_nodes ( 'prefix' ) % % where % % * 'prefix'_nodes.txt contains the node coordinates; % * 'prefix'_elements.txt contains the element definitions. % * 'prefix'_nodes_boundary.txt will contain the boundary node coordinates % * 'prefix'_nodes_boundary_indices.txt will contain boundary node indices. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 02 October 2009 % % Author: % % John Burkardt % timestamp ( ); fprintf ( 1, '\n' ); fprintf ( 1, 'TRIANGULATION_BOUNDARY_NODES\n' ); fprintf ( 1, ' MATLAB version\n' ); fprintf ( 1, '\n' ); fprintf ( 1, ' Identify triangulation nodes on the boundary.\n' ); fprintf ( 1, '\n' ); fprintf ( 1, '* Read a dataset of NODE_NUM points in 2 dimensions;\n' ); fprintf ( 1, '\n' ); fprintf ( 1, '* Read an associated triangulation dataset of \n' ); fprintf ( 1, ' triangles using 3 or 6 nodes;\n' ); fprintf ( 1, '\n' ); fprintf ( 1, '* Determine which nodes are on the boundary;\n' ); fprintf ( 1, '\n' ); fprintf ( 1, '* Print a list of the node coordinates and indices;\n' ); fprintf ( 1, '\n' ); fprintf ( 1, '* Write a file of the boundary node indices.\n' ); fprintf ( 1, '* Write a file of the boundary node coordinates.\n' ); % % The command line argument is the common filename prefix. % if ( nargin < 1 ) fprintf ( 1, '\n' ); fprintf ( 1, 'TRIANGULATION_BOUNDARY_NODES:\n' ); prefix = input ( ... 'Please enter the filename prefix:' ); end % % Create the filenames. % node_filename = strcat ( prefix, '_nodes.txt' ); element_filename = strcat ( prefix, '_elements.txt' ); node_boundary_filename = strcat ( prefix, '_nodes_boundary.txt' ); node_boundary_indices_filename = strcat ( prefix, '_nodes_boundary_indices.txt' ); % % Read the node coordinates. % [ dim_num, node_num ] = r8mat_header_read ( node_filename ); fprintf ( 1, '\n' ); fprintf ( 1, ' Read the header of "%s"\n.', node_filename ); fprintf ( 1, '\n' ); fprintf ( 1, ' Spatial dimension DIM_NUM = %d\n', dim_num ); fprintf ( 1, ' Number of nodes NODE_NUM = %d\n', node_num ); node_xy = r8mat_data_read ( node_filename, dim_num, node_num ); fprintf ( 1, '\n' ); fprintf ( 1, ' Read the data in "%s"\n', node_filename ); r8mat_transpose_print_some ( dim_num, node_num, node_xy, 1, 1, ... dim_num, 5, ' Portion of coordinate data from file:' ); % % Read the element data. % [ triangle_order, triangle_num ] = i4mat_header_read ( ... element_filename ); fprintf ( 1, '\n' ); fprintf ( 1, ' Read the header of "%s"\n', ... element_filename ); fprintf ( 1, '\n' ); fprintf ( 1, ' Triangle order = %d\n', triangle_order ); fprintf ( 1, ' Number of triangles = %d\n', triangle_num ); triangle_node = i4mat_data_read ( element_filename, ... triangle_order, triangle_num ); fprintf ( 1, '\n' ); fprintf ( 1, ' Read the data in "%s".\n', ... element_filename ); i4mat_transpose_print_some ( triangle_order, triangle_num, ... triangle_node, 1, 1, triangle_order, 5, ... ' Portion of triangle file:' ); % % Detect and correct 0-based indexing. % triangle_node = mesh_base_one ( node_num, triangle_order, triangle_num, ... triangle_node ); % % Determine which nodes lie on the boundary. % if ( triangle_order == 3 ) node_boundary = triangulation_order3_boundary_node ( node_num, ... triangle_num, triangle_node ); elseif ( triangle_order == 6 ) node_boundary = triangulation_order6_boundary_node ( node_num, ... triangle_num, triangle_node ); end % % Write the output file. % node_boundary_num = 0; for node = 1 : node_num if ( node_boundary(node) ) node_boundary_num = node_boundary_num + 1; end end fprintf ( 1, '\n' ); fprintf ( 1, ' Boundary nodes:\n' ); fprintf ( 1, '\n' ); fprintf ( 1, ' # Index X Y\n' ); fprintf ( 1, '\n' ); node2 = 0; for node = 1 : node_num if ( node_boundary(node) ) node2 = node2 + 1; node_boundary_xy(1:2,node2) = node_xy(1:2,node); fprintf ( 1, ' %8d %8d %14f %14f\n', ... node2, node, node_xy(1:2,node) ); end end % % Write a file containing the boundary node indices. % node2 = 0; for node = 1 : node_num if ( node_boundary(node) ) node2 = node2 + 1; node_indices(node2) = node; end end i4mat_write ( node_boundary_indices_filename, 1, node_boundary_num, ... node_indices ); fprintf ( 1, '\n' ); fprintf ( 1, ' The file "%s" lists the boundary node indices.\n', ... node_boundary_indices_filename ); % % Write a file containing the boundary node coordinates. % r8mat_write ( node_boundary_filename, dim_num, node_boundary_num, ... node_boundary_xy ); fprintf ( 1, '\n' ); fprintf ( 1, ' The file "%s" lists the boundary node coordinates.\n', ... node_boundary_filename ); fprintf ( 1, '\n' ); fprintf ( 1, 'TRIANGULATION_BOUNDARY_NODES\n' ); fprintf ( 1, ' Normal end of execution.\n' ); fprintf ( 1, '\n' ); timestamp ( ); return end function c = ch_cap ( c ) %*****************************************************************************80 % %% CH_CAP capitalizes a single character. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 22 November 2003 % % Author: % % John Burkardt % % Parameters: % % Input, character C, the character to capitalize. % % Output, character C, the capitalized character. % if ( 'a' <= c & c <= 'z' ) c = c + 'A' - 'a'; end return end function truefalse = ch_eqi ( c1, c2 ) %*****************************************************************************80 % %% CH_EQI is a case insensitive comparison of two characters for equality. % % Example: % % CH_EQI ( 'A', 'a' ) is TRUE. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 28 July 2000 % % Author: % % John Burkardt % % Parameters: % % Input, character C1, C2, the characters to compare. % % Output, logical TRUEFALSE, is TRUE (1) if the characters are equal. % FALSE = 0; TRUE = 1; if ( ch_cap ( c1 ) == ch_cap ( c2 ) ) truefalse = TRUE; else truefalse = FALSE; end return end function digit = ch_to_digit ( c ) %*****************************************************************************80 % %% CH_TO_DIGIT returns the integer value of a base 10 digit. % % Example: % % C DIGIT % --- ----- % '0' 0 % '1' 1 % ... ... % '9' 9 % ' ' 0 % 'X' -1 % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 22 November 2003 % % Author: % % John Burkardt % % Parameters: % % Input, character C, the decimal digit, '0' through '9' or blank % are legal. % % Output, integer DIGIT, the corresponding integer value. If C was % 'illegal', then DIGIT is -1. % if ( '0' <= c & c <= '9' ) digit = c - '0'; elseif ( c == ' ' ) digit = 0; else digit = -1; end return end function column_num = file_column_count ( input_file_name ) %*****************************************************************************80 % %% FILE_COLUMN_COUNT counts the columns in the first line of a file. % % Discussion: % % The file is assumed to be a simple text file. % % Most lines of the file are presumed to consist of COLUMN_NUM words, % separated by spaces. There may also be some blank lines, and some % comment lines, which have a "#" in column 1. % % The routine tries to find the first non-comment non-blank line and % counts the number of words in that line. % % If all lines are blanks or comments, it goes back and tries to analyze % a comment line. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 21 February 2004 % % Author: % % John Burkardt % % Parameters: % % Input, string INPUT_FILE_NAME, the name of the file. % % Output, integer COLUMN_NUM, the number of columns in the file. % FALSE = 0; TRUE = 1; % % Open the file. % input_unit = fopen ( input_file_name ); if ( input_unit < 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'FILE_COLUMN_COUNT - Error!\n' ); fprintf ( 1, ' Could not open the file "%s".\n', input_file_name ); error ( 'FILE_COLUMN_COUNT - Error!' ); column_num = -1; return; end % % Read one line, but skip blank lines and comment lines. % Use FGETL so we drop the newline character! % got_one = FALSE; while ( 1 ) line = fgetl ( input_unit ); if ( line == -1 ) break; end if ( s_len_trim ( line ) == 0 ) elseif ( line(1) == '#' ) else got_one = TRUE; break; end end fclose ( input_unit ); if ( got_one == FALSE ) fprintf ( 1, '\n' ); fprintf ( 1, 'FILE_COLUMN_COUNT - Warning!\n' ); fprintf ( 1, ' The file does not seem to contain any data.\n' ); column_num = -1; return; end column_num = s_word_count ( line ); return end function row_num = file_row_count ( input_file_name ) %*****************************************************************************80 % %% FILE_ROW_COUNT counts the number of row records in a file. % % Discussion: % % Each input line is a "RECORD". % % The records are divided into three groups: % % * BLANK LINES (nothing but blanks) % * COMMENT LINES (begin with a '#') % * DATA RECORDS (anything else) % % The value returned by the function is the number of data records. % % By the way, if the MATLAB routine FGETS is used, instead of % FGETL, then the variable LINE will include line termination % characters, which means that a blank line would not actually % have zero characters. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 31 December 2006 % % Author: % % John Burkardt % % Parameters: % % Input, string INPUT_FILE_NAME, the name of the input file. % % Output, integer ROW_NUM, the number of rows found. % input_unit = fopen ( input_file_name ); if ( input_unit < 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'FILE_ROW_COUNT - Error!\n' ); fprintf ( 1, ' Could not open the file "%s".\n', input_file_name ); error ( 'FILE_ROW_COUNT - Error!' ); row_num = -1; return; end blank_num = 0; comment_num = 0; row_num = 0; record_num = 0; while ( 1 ) line = fgetl ( input_unit ); if ( line == -1 ) break; end record_num = record_num + 1; record_length = s_len_trim ( line ); if ( record_length <= 0 ) blank_num = blank_num + 1; elseif ( line(1) == '#' ) comment_num = comment_num + 1; else row_num = row_num + 1; end end fclose ( input_unit ); return end function isgn = i4col_compare ( m, n, a, i, j ) %*****************************************************************************80 % %% I4COL_COMPARE compares columns I and J of a integer array. % % Example: % % Input: % % M = 3, N = 4, I = 2, J = 4 % % A = ( % 1 2 3 4 % 5 6 7 8 % 9 10 11 12 ) % % Output: % % ISGN = -1 % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 12 June 2005 % % Author: % % John Burkardt % % Parameters: % % Input, integer M, N, the number of rows and columns. % % Input, integer A(M,N), an array of N columns of vectors of length M. % % Input, integer I, J, the columns to be compared. % I and J must be between 1 and N. % % Output, integer ISGN, the results of the comparison: % -1, column I < column J, % 0, column I = column J, % +1, column J < column I. % % % Check. % if ( i < 1) fprintf ( 1, '\n' ); fprintf ( 1, 'I4COL_COMPARE - Fatal error!\n' ); fprintf ( 1, ' Column index I = %d < 1.\n', i ); error ( 'I4COL_COMPARE - Fatal error!' ); end if ( n < i ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4COL_COMPARE - Fatal error!\n' ); fprintf ( 1, ' N = %d < column index I = %d.\n', n, i ); error ( 'I4COL_COMPARE - Fatal error!' ); end if ( j < 1 ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4COL_COMPARE - Fatal error!\n' ); fprintf ( 1, ' Column index J = %d < 1.\n', j ); error ( 'I4COL_COMPARE - Fatal error!' ); end if ( n < j ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4COL_COMPARE - Fatal error!\n' ); fprintf ( 1, ' N = %d < column index J = %d.\n', n, j ); error ( 'I4COL_COMPARE - Fatal error!' ); end isgn = 0; if ( i == j ) return end k = 1; while ( k <= m ) if ( a(k,i) < a(k,j) ) isgn = -1; return elseif ( a(k,j) < a(k,i) ) isgn = +1; return end k = k + 1; end return end function a = i4col_sort_a ( m, n, a ) %*****************************************************************************80 % %% I4COL_SORT_A ascending sorts an I4COL. % % Discussion: % % In lexicographic order, the statement "X < Y", applied to two real % vectors X and Y of length M, means that there is some index I, with % 1 <= I <= M, with the property that % % X(J) = Y(J) for J < I, % and % X(I) < Y(I). % % In other words, the first time they differ, X is smaller. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 20 February 2005 % % Author: % % John Burkardt % % Parameters: % % Input, integer M, the number of rows of A, and the length of % a vector of data. % % Input, integer N, the number of columns of A. % % Input, integer A(M,N), the array of N columns of M-vectors. % % Output, integer A(M,N), the columns of A have been sorted in ascending % lexicographic order. % if ( m <= 0 ) return end if ( n <= 1 ) return end % % Initialize. % i = 0; indx = 0; isgn = 0; j = 0; % % Call the external heap sorter. % while ( 1 ) [ indx, i, j ] = sort_heap_external ( n, indx, isgn ); % % Interchange the I and J objects. % if ( 0 < indx ) a = i4col_swap ( m, n, a, i, j ); % % Compare the I and J objects. % elseif ( indx < 0 ) isgn = i4col_compare ( m, n, a, i, j ); elseif ( indx == 0 ) break end end return end function a = i4col_swap ( m, n, a, i, j ) %*****************************************************************************80 % %% I4COL_SWAP swaps columns I and J of a integer array of column data. % % Example: % % Input: % % M = 3, N = 4, I = 2, J = 4 % % A = ( % 1 2 3 4 % 5 6 7 8 % 9 10 11 12 ) % % Output: % % A = ( % 1 4 3 2 % 5 8 7 6 % 9 12 11 10 ) % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 19 February 2005 % % Author: % % John Burkardt % % Parameters: % % Input, integer M, N, the number of rows and columns in the array. % % Input, integer A(M,N), an array of N columns of length M. % % Input, integer I, J, the columns to be swapped. % % Output, integer A(M,N), the array, with columns I and J swapped. % if ( i < 1 | n < i | j < 1 | n < j ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4COL_SWAP - Fatal error!\n' ); fprintf ( 1, ' I or J is out of bounds.\n' ); fprintf ( 1, ' I = %d\n', i ); fprintf ( 1, ' J = %d\n', j ); fprintf ( 1, ' N = %d\n', n ); error ( 'I4COL_SWAP - Fatal error!' ); end if ( i == j ) return end col(1:m) = a(1:m,i)'; a(1:m,i) = a(1:m,j); a(1:m,j) = col(1:m)'; return end function table = i4mat_data_read ( input_filename, m, n ) %*****************************************************************************80 % %% I4MAT_DATA_READ reads data from an I4MAT file. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 27 January 2006 % % Author: % % John Burkardt % % Parameters: % % Input, string INPUT_FILENAME, the name of the input file. % % Input, integer M, N, the number of rows and columns in the data. % % Output, integer TABLE(M,N), the point coordinates. % table = []; % % Build up the format string for reading M real numbers. % string = ' '; for i = 0 : m string = strcat ( string, ' %d' ); end input_unit = fopen ( input_filename ); if ( input_unit < 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4MAT_DATA_READ - Error!\n' ); fprintf ( 1, ' Could not open the input file.\n' ); error ( 'I4MAT_DATA_READ - Error!' ); return; end i = 0; while ( i < n ) line = fgets ( input_unit ); if ( line == -1 ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4MAT_DATA_READ - Error!\n' ); fprintf ( 1, ' End of input while reading data.\n' ); error ( 'I4MAT_DATA_READ - Error!' ); end if ( line(1) == '#' ) elseif ( s_len_trim ( line ) == 0 ) else [ x, count ] = sscanf ( line, string ); if ( count == m ) i = i + 1; table(1:m,i) = x(1:m); end end end fclose ( input_unit ); return end function [ m, n ] = i4mat_header_read ( input_filename ) %*****************************************************************************80 % %% I4MAT_HEADER_READ reads the header from an I4MAT file. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 22 October 2004 % % Author: % % John Burkardt % % Parameters: % % Input, string INPUT_FILENAME, the name of the input file. % % Output, integer M, the spatial dimension. % % Output, integer N, the number of points. % m = file_column_count ( input_filename ); if ( m <= 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4MAT_HEADER_READ - Fatal error!\n' ); fprintf ( 1, ' There was some kind of I/O problem while trying\n' ); fprintf ( 1, ' to count the number of data columns in\n' ); fprintf ( 1, ' the file %s.\n', input_filename ); end n = file_row_count ( input_filename ); if ( n <= 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4MAT_HEADER_READ - Fatal error!\n' ); fprintf ( 1, ' There was some kind of I/O problem while trying\n' ); fprintf ( 1, ' to count the number of data rows in\n' ); fprintf ( 1, ' the file %s\n', input_filename ); end return end function i4mat_transpose_print_some ( m, n, a, ilo, jlo, ihi, jhi, title ) %*****************************************************************************80 % %% I4MAT_TRANSPOSE_PRINT_SOME prints some of an I4MAT, transposed. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 21 June 2005 % % Author: % % John Burkardt % % Parameters: % % Input, integer M, N, the number of rows and columns. % % Input, integer A(M,N), an M by N matrix to be printed. % % Input, integer ILO, JLO, the first row and column to print. % % Input, integer IHI, JHI, the last row and column to print. % % Input, string TITLE, an optional title. % incx = 10; if ( 0 < s_len_trim ( title ) ) fprintf ( 1, '\n' ); fprintf ( 1, '%s\n', title ); end for i2lo = max ( ilo, 1 ) : incx : min ( ihi, m ) i2hi = i2lo + incx - 1; i2hi = min ( i2hi, m ); i2hi = min ( i2hi, ihi ); inc = i2hi + 1 - i2lo; fprintf ( 1, '\n' ); fprintf ( 1, ' Row: ' ); for i = i2lo : i2hi fprintf ( 1, '%7d ', i ); end fprintf ( 1, '\n' ); fprintf ( 1, ' Col\n' ); fprintf ( 1, '\n' ); j2lo = max ( jlo, 1 ); j2hi = min ( jhi, n ); for j = j2lo : j2hi fprintf ( 1, '%5d ', j ); for i2 = 1 : inc i = i2lo - 1 + i2; fprintf ( 1, '%7d ', a(i,j) ); end fprintf ( 1, '\n' ); end end return end function i4mat_write ( output_filename, m, n, table ) %*****************************************************************************80 % %% I4MAT_WRITE writes an I4MAT file. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 09 August 2009 % % Author: % % John Burkardt % % Parameters: % % Input, string OUTPUT_FILENAME, the output filename. % % Input, integer M, the spatial dimension. % % Input, integer N, the number of points. % % Input, integer TABLE(M,N), the points. % % Input, logical HEADER, is TRUE if the header is to be included. % % % Open the file. % output_unit = fopen ( output_filename, 'wt' ); if ( output_unit < 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'I4MAT_WRITE - Error!\n' ); fprintf ( 1, ' Could not open the output file.\n' ); error ( 'I4MAT_WRITE - Error!' ); return; end % % Write the data. % for j = 1 : n for i = 1 : m fprintf ( output_unit, ' %12d', round ( table(i,j) ) ); end fprintf ( output_unit, '\n' ); end % % Close the file. % fclose ( output_unit ); return end function element_node = mesh_base_one ( node_num, element_order, ... element_num, element_node ) %*****************************************************************************80 % %% MESH_BASE_ONE ensures that the element definition is one-based. % % Discussion: % % The ELEMENT_NODE array contains nodes indices that form elements. % The convention for node indexing might start at 0 or at 1. % Since a MATLAB program will naturally assume a 1-based indexing, it is % necessary to check a given element definition and, if it is actually % 0-based, to convert it. % % This function attempts to detect 0-based node indexing and correct it. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 29 September 2009 % % Author: % % John Burkardt % % Parameters: % % Input, integer NODE_NUM, the number of nodes. % % Input, integer ELEMENT_ORDER, the order of the elements. % % Input, integer ELEMENT_NUM, the number of elements. % % Input/output, integer ELEMENT_NODE(ELEMENT_ORDE,ELEMENT_NUM), the element % definitions. % node_min = min ( min ( element_node(1:element_order,1:element_num) ) ); node_max = max ( max ( element_node(1:element_order,1:element_num) ) ); if ( node_min == 0 & node_max == node_num - 1 ) fprintf ( 1, '\n' ); fprintf ( 1, 'MESH_BASE_ONE:\n' ); fprintf ( 1, ' The element indexing appears to be 0-based!\n' ); fprintf ( 1, ' This will be converted to 1-based.\n' ); element_node(1:element_order,1:element_num) = ... element_node(1:element_order,1:element_num) - 1; elseif ( node_min == 1 & node_max == node_num ) fprintf ( 1, '\n' ); fprintf ( 1, 'MESH_BASE_ONE:\n' ); fprintf ( 1, ' The element indexing appears to be 1-based!\n' ); fprintf ( 1, ' No conversion is necessary.\n' ); else fprintf ( 1, '\n' ); fprintf ( 1, 'MESH_BASE_ONE - Warning!\n' ); fprintf ( 1, ' The element indexing is not of a recognized type.\n' ); fprintf ( 1, ' NODE_MIN = %d\n', node_min ); fprintf ( 1, ' NODE_MAX = %d\n', node_max ); fprintf ( 1, ' NODE_NUM = %d\n', node_num ); end return end function table = r8mat_data_read ( input_filename, m, n ) %*****************************************************************************80 % %% R8MAT_DATA_READ reads data from an R8MAT file. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 27 January 2006 % % Author: % % John Burkardt % % Parameters: % % Input, string INPUT_FILENAME, the name of the input file. % % Input, integer M, N, the number of rows and columns of data. % % Output, real TABLE(M,N), the point coordinates. % table = []; % % Build up the format string for reading M real numbers. % string = ' '; for i = 0 : m string = strcat ( string, ' %f' ); end input_unit = fopen ( input_filename ); if ( input_unit < 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'R8MAT_DATA_READ - Error!\n' ); fprintf ( 1, ' Could not open the file.\n' ); error ( 'R8MAT_DATA_READ - Error!' ); return; end i = 0; while ( i < n ) line = fgets ( input_unit ); if ( line == -1 ) break; end if ( line(1) == '#' ) elseif ( s_len_trim ( line ) == 0 ) else [ x, count ] = sscanf ( line, string ); if ( count == m ) i = i + 1; table(1:m,i) = x(1:m); end end end fclose ( input_unit ); return end function [ m, n ] = r8mat_header_read ( input_filename ) %*****************************************************************************80 % %% R8MAT_HEADER_READ reads the header from an R8MAT file. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 22 October 2004 % % Author: % % John Burkardt % % Parameters: % % Input, string INPUT_FILENAME, the name of the input file. % % Output, integer M, the spatial dimension. % % Output, integer N, the number of points. % m = file_column_count ( input_filename ); if ( m <= 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'R8MAT_HEADER_READ - Fatal error!\n' ); fprintf ( 1, ' There was some kind of I/O problem while trying\n' ); fprintf ( 1, ' to count the number of data columns in\n' ); fprintf ( 1, ' the file %s.\n', input_filename ); end n = file_row_count ( input_filename ); if ( n <= 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'R8MAT_HEADER_READ - Fatal error!\n' ); fprintf ( 1, ' There was some kind of I/O problem while trying\n' ); fprintf ( 1, ' to count the number of data rows in\n' ); fprintf ( 1, ' the file %s\n', input_filename ); end return end function r8mat_transpose_print_some ( m, n, a, ilo, jlo, ihi, jhi, title ) %*****************************************************************************80 % %% R8MAT_TRANSPOSE_PRINT_SOME prints some of an R8MAT, transposed. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 23 May 2005 % % Author: % % John Burkardt % % Parameters: % % Input, integer M, N, the number of rows and columns. % % Input, real A(M,N), an M by N matrix to be printed. % % Input, integer ILO, JLO, the first row and column to print. % % Input, integer IHI, JHI, the last row and column to print. % % Input, string TITLE, an optional title. % incx = 5; if ( 0 < s_len_trim ( title ) ) fprintf ( 1, '\n' ); fprintf ( 1, '%s\n', title ); end for i2lo = max ( ilo, 1 ) : incx : min ( ihi, m ) i2hi = i2lo + incx - 1; i2hi = min ( i2hi, m ); i2hi = min ( i2hi, ihi ); inc = i2hi + 1 - i2lo; fprintf ( 1, '\n' ); fprintf ( 1, ' Row: ' ); for i = i2lo : i2hi fprintf ( 1, '%7d ', i ); end fprintf ( 1, '\n' ); fprintf ( 1, ' Col\n' ); j2lo = max ( jlo, 1 ); j2hi = min ( jhi, n ); for j = j2lo : j2hi fprintf ( 1, '%5d ', j ); for i2 = 1 : inc i = i2lo - 1 + i2; fprintf ( 1, '%12f', a(i,j) ); end fprintf ( 1, '\n' ); end end return end function r8mat_write ( output_filename, m, n, table ) %*****************************************************************************80 % %% R8MAT_WRITE writes an R8MAT file. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 09 August 2009 % % Author: % % John Burkardt % % Parameters: % % Input, string OUTPUT_FILENAME, the output filename. % % Input, integer M, the spatial dimension. % % Input, integer N, the number of points. % % Input, real TABLE(M,N), the points. % % % Open the file. % output_unit = fopen ( output_filename, 'wt' ); if ( output_unit < 0 ) fprintf ( 1, '\n' ); fprintf ( 1, 'R8MAT_WRITE - Error!\n' ); fprintf ( 1, ' Could not open the output file.\n' ); error ( 'R8MAT_WRITE - Error!' ); return; end % % Write the data. % % For greater precision, try: % % fprintf ( output_unit, ' %24,16f', table(i,j) ); % for j = 1 : n for i = 1 : m fprintf ( output_unit, ' %14f', table(i,j) ); end fprintf ( output_unit, '\n' ); end % % Close the file. % fclose ( output_unit ); return end function value = s_index_last_c ( s, c ) %*****************************************************************************80 % %% S_INDEX_LAST_C finds the LAST occurrence of a given character. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 20 November 2004 % % Author: % % John Burkardt % % Parameters: % % Input, character S(*), the string to be searched. % % Input, character C, the character to search for. % % Output, integer VALUE, the index in S where C occurs % last, or -1 if it does not occur. % if ( c == ' ' ) s_len = length ( s ); else s_len = s_len_trim ( s ); end for i = s_len : -1 : 1 if ( s(i) == c ) value = i; return end end value = -1; return end function len = s_len_trim ( s ) %*****************************************************************************80 % %% S_LEN_TRIM returns the length of a character string to the last nonblank. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 14 June 2003 % % Author: % % John Burkardt % % Parameters: % % Input, string S, the string to be measured. % % Output, integer LEN, the length of the string up to the last nonblank. % len = length ( s ); while ( 0 < len ) if ( s(len) ~= ' ' ) return end len = len - 1; end return end function word_num = s_word_count ( s ) %*****************************************************************************80 % %% S_WORD_COUNT counts the number of "words" in a string. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 30 January 2006 % % Author: % % John Burkardt % % Parameters: % % Input, string S, the string to be examined. % % Output, integer WORD_NUM, the number of "words" in the string. % Words are presumed to be separated by one or more blanks. % FALSE = 0; TRUE = 1; word_num = 0; s_length = length ( s ); if ( s_length <= 0 ) return; end blank = TRUE; for i = 1 : s_length if ( s(i) == ' ' ) blank = TRUE; elseif ( blank == TRUE ) word_num = word_num + 1; blank = FALSE; end end return end function [ indx, i, j ] = sort_heap_external ( n, indx, isgn ) %*****************************************************************************80 % %% SORT_HEAP_EXTERNAL externally sorts a list of items into ascending order. % % Discussion: % % The actual list of data is not passed to the routine. Hence this % routine may be used to sort integers, reals, numbers, names, % dates, shoe sizes, and so on. After each call, the routine asks % the user to compare or interchange two items, until a special % return value signals that the sorting is completed. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 05 February 2004 % % Author: % % Original FORTRAN77 version by Albert Nijenhuis, Herbert Wilf. % MATLAB version by John Burkardt % % Reference: % % Albert Nijenhuis, Herbert Wilf. % Combinatorial Algorithms, % Academic Press, 1978, second edition, % ISBN 0-12-519260-6. % % Parameters: % % Input, integer N, the number of items to be sorted. % % Input, integer INDX, the main communication signal. % The user must set INDX to 0 before the first call. % Thereafter, the user should set the input value of INDX % to the output value from the previous call. % % Input, integer ISGN, results of comparison of elements I and J. % (Used only when the previous call returned INDX less than 0). % ISGN <= 0 means I is less than or equal to J; % 0 <= ISGN means I is greater than or equal to J. % % Output, integer INDX, the main communication signal. % If INDX is % % greater than 0, the user should: % * interchange items I and J; % * call again. % % less than 0, the user should: % * compare items I and J; % * set ISGN = -1 if I < J, ISGN = +1 if J < I; % * call again. % % equal to 0, the sorting is done. % % Output, integer I, J, the indices of two items. % On return with INDX positive, elements I and J should be interchanged. % On return with INDX negative, elements I and J should be compared, and % the result reported in ISGN on the next call. % persistent i_save; persistent j_save; persistent k; persistent k1; persistent n1; % % INDX = 0: This is the first call. % if ( indx == 0 ) i_save = -1; j_save = -1; k = floor ( n / 2 ); k1 = k; n1 = n; % % INDX < 0: The user is returning the results of a comparison. % elseif ( indx < 0 ) if ( indx == -2 ) if ( isgn < 0 ) i_save = i_save + 1; end j_save = k1; k1 = i_save; indx = -1; i = i_save; j = j_save; return; end if ( 0 < isgn ) indx = 2; i = i_save; j = j_save; return; end if ( k <= 1 ) if ( n1 == 1 ) i_save = 0; j_save = 0; indx = 0; else i_save = n1; n1 = n1 - 1; j_save = 1; indx = 1; end i = i_save; j = j_save; return; end k = k - 1; k1 = k; % % 0 < INDX, the user was asked to make an interchange. % elseif ( indx == 1 ) k1 = k; end while ( 1 ) i_save = 2 * k1; if ( i_save == n1 ) j_save = k1; k1 = i_save; indx = -1; i = i_save; j = j_save; return; elseif ( i_save <= n1 ) j_save = i_save + 1; indx = -2; i = i_save; j = j_save; return; end if ( k <= 1 ) break; end k = k - 1; k1 = k; end if ( n1 == 1 ) i_save = 0; j_save = 0; indx = 0; i = i_save; j = j_save; else i_save = n1; n1 = n1 - 1; j_save = 1; indx = 1; i = i_save; j = j_save; end return end function timestamp ( ) %*****************************************************************************80 % %% TIMESTAMP prints the current YMDHMS date as a timestamp. % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 14 February 2003 % % Author: % % John Burkardt % t = now; c = datevec ( t ); s = datestr ( c, 0 ); fprintf ( 1, '%s\n', s ); return end function node_boundary = triangulation_order3_boundary_node ( node_num, ... triangle_num, triangle_node ) %*****************************************************************************80 % %% TRIANGULATION_ORDER3_BOUNDARY_NODE indicates which nodes are on the boundary. % % Discussion: % % This routine is given a triangulation, an abstract list of triples % of nodes. It is assumed that the nodes in each triangle are listed % in a counterclockwise order, although the routine should work % if the nodes are consistently listed in a clockwise order as well. % % It is assumed that each edge of the triangulation is either % * an INTERIOR edge, which is listed twice, once with positive % orientation and once with negative orientation, or; % * a BOUNDARY edge, which will occur only once. % % This routine should work even if the region has holes - as long % as the boundary of the hole comprises more than 3 edges! % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 12 June 2005 % % Author: % % John Burkardt % % Parameters: % % Input, integer NODE_NUM, the number of nodes. % % Input, integer TRIANGLE_NUM, the number of triangles. % % Input, integer TRIANGLE_NODE(3,TRIANGLE_NUM), the nodes that make up the % triangles. These should be listed in counterclockwise order. % % Output, logical NODE_BOUNDARY(NODE_NUM), is TRUE if the node % is on a boundary edge. % m = 2; n = 3 * triangle_num; % % Set up the edge array. % edge(1:2, 1: triangle_num) = triangle_node(1:2,1:triangle_num); edge(1:2, triangle_num+1:2*triangle_num) = triangle_node(2:3,1:triangle_num); edge(1, 2*triangle_num+1:3*triangle_num) = triangle_node(3, 1:triangle_num); edge(2, 2*triangle_num+1:3*triangle_num) = triangle_node(1, 1:triangle_num); % % In each column, force the smaller entry to appear first. % e1(1:n) = min ( edge(1:2,1:n) ); e2(1:n) = max ( edge(1:2,1:n) ); edge(1,1:n) = e1(1:n); edge(2,1:n) = e2(1:n); % % Ascending sort the column array. % edge = i4col_sort_a ( m, n, edge ); % % Records which appear twice are internal edges and can be ignored. % node_boundary(1:node_num) = 0; j = 0; while ( j < 3 * triangle_num ) j = j + 1; if ( j == 3 * triangle_num ) node_boundary(edge(1:m,j)) = 1; elseif ( all ( edge(1:m,j) == edge(1:m,j+1) ) ) j = j + 1; else node_boundary(edge(1:m,j)) = 1; end end return end function node_boundary = triangulation_order6_boundary_node ( node_num, ... triangle_num, triangle_node ) %*****************************************************************************80 % %% TRIANGULATION_ORDER6_BOUNDARY_NODE indicates which nodes are on the boundary. % % Discussion: % % This routine is given an order 6 triangulation, an abstract list of sets % of six nodes. The vertices are listed clockwise, then the % midside nodes. % % It is assumed that each edge of the triangulation is either % * an INTERIOR edge, which is listed twice, once with positive % orientation and once with negative orientation, or; % * a BOUNDARY edge, which will occur only once. % % This routine should work even if the region has holes - as long % as the boundary of the hole comprises more than 3 edges! % % Licensing: % % This code is distributed under the GNU LGPL license. % % Modified: % % 13 June 2005 % % Author: % % John Burkardt % % Parameters: % % Input, integer NODE_NUM, the number of nodes. % % Input, integer TRIANGLE_NUM, the number of triangles. % % Input, integer TRIANGLE_NODE(6,TRIANGLE_NUM), the nodes that make up the % triangles. % % Output, logical NODE_BOUNDARY(NODE_NUM), is TRUE if the node % is on a boundary edge. % m = 3; n = 3 * triangle_num; % % Set up the edge array. The midside node is listed last, as % it is not needed for the sorting process. % edge(1, 1: triangle_num) = triangle_node(1,1:triangle_num); edge(2, 1: triangle_num) = triangle_node(4,1:triangle_num); edge(3, 1: triangle_num) = triangle_node(2,1:triangle_num); edge(1, triangle_num+1:2*triangle_num) = triangle_node(2,1:triangle_num); edge(2, triangle_num+1:2*triangle_num) = triangle_node(5,1:triangle_num); edge(3, triangle_num+1:2*triangle_num) = triangle_node(3,1:triangle_num); edge(1,2*triangle_num+1:3*triangle_num) = triangle_node(3,1:triangle_num); edge(2,2*triangle_num+1:3*triangle_num) = triangle_node(6,1:triangle_num); edge(3,2*triangle_num+1:3*triangle_num) = triangle_node(1,1:triangle_num); % % In each column, force the smaller of the two vertices to appear first. % e1(1:n) = min ( edge(1:2:3,1:n) ); e2(1:n) = max ( edge(1:2:3,1:n) ); edge(1,1:n) = e1(1:n); edge(3,1:n) = e2(1:n); % % Ascending sort the column array. % edge = i4col_sort_a ( m, n, edge ); % % Records which appear twice are internal edges and can be ignored. % node_boundary(1:node_num) = 0; i = 0; while ( i < 3 * triangle_num ) i = i + 1; if ( i == 3 * triangle_num ) node_boundary(edge(1:m,i)) = 1; elseif ( all ( edge(1:m,i) == edge(1:m,i+1) ) ) i = i + 1; else node_boundary(edge(1:m,i)) = 1; end end return end