program main !*****************************************************************************80 ! !! MAIN is the main program for ST_TO_DSP. ! ! Discussion: ! ! ST_TO_DSP converts an ST sparse matrix file to DSP format. ! ! Each line of the ST file has the form I, J, A(I,J). ! The DSP file uses the same format, but DSP files use 1-based ! indexing rather than 0-based indexing. ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 03 August 2006 ! ! Author: ! ! John Burkardt ! ! Usage: ! ! st_to_dsp file.st ! implicit none real ( kind = 8 ) a integer ( kind = 4 ) arg_num integer ( kind = 4 ) i integer ( kind = 4 ) iarg integer ( kind = 4 ) iargc character ( len = 255 ) input_filename integer ( kind = 4 ) input_unit integer ( kind = 4 ) ios integer ( kind = 4 ) j integer ( kind = 4 ) line_num character ( len = 255 ) output_filename integer ( kind = 4 ) output_unit call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ST_TO_DSP' write ( *, '(a)' ) ' FORTRAN90 version' write ( *, '(a)' ) ' Read an ST sparse matrix file,' write ( *, '(a)' ) ' write the corresponding DSP sparse matrix file.' ! ! Get the number of command line arguments. ! arg_num = iargc ( ) ! ! If at least one command line argument, it's the input file name. ! if ( 1 <= arg_num ) then iarg = 1 call getarg ( iarg, input_filename ) else write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ST_TO_DSP:' write ( *, '(a)' ) ' Please enter the name of the input file.' read ( *, '(a)' ) input_filename end if ! ! Need to create the output file name from the input filename. ! output_filename = input_filename call filename_ext_swap ( output_filename, 'dsp' ) ! ! Read a line, write a line. ! call get_unit ( input_unit ) open ( unit = input_unit, file = input_filename, status = 'old', & iostat = ios ) if ( ios /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ST_TO_DSP - Fatal error!' write ( *, '(a)' ) ' Could not open the input file "' & // trim ( input_filename ) // '".' stop end if call get_unit ( output_unit ) open ( unit = output_unit, file = output_filename, status = 'replace' ) line_num = 0 do read ( input_unit, *, iostat = ios ) i, j, a if ( ios /= 0 ) then exit end if write ( output_unit, * ) i + 1, j + 1, a line_num = line_num + 1 end do close ( unit = input_unit ) close ( unit = output_unit ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ST_TO_DSP:' write ( *, '(a,i8)' ) ' Number of records read was ', line_num write ( *, '(a)' ) ' Created output DSP file: "' & // trim ( output_filename ) // '".' ! ! Terminate. ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ST_TO_DSP:' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) ' ' call timestamp ( ) stop end subroutine filename_ext_get ( file_name, i, j ) !*****************************************************************************80 ! !! FILENAME_EXT_GET determines the "extension" of a file name. ! ! Discussion: ! ! The "extension" of a filename is the string of characters ! that appears after the LAST period in the name. A file ! with no period, or with a period as the last character ! in the name, has a "null" extension. ! ! Blanks are unusual in filenames. This routine ignores all ! trailing blanks, but will treat initial or internal blanks ! as regular characters acceptable in a file name. ! ! Example: ! ! FILE_NAME I J ! ! bob.for 4 7 ! N.B.C.D 6 7 ! Naomi. 6 6 ! Arthur -1 -1 ! .com 1 1 ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 17 July 1998 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) FILE_NAME, a file name to be examined. ! ! Output, integer ( kind = 4 ) I, J, the indices of the first and last ! characters in the file extension. ! If no period occurs in FILE_NAME, then ! I = J = -1; ! Otherwise, ! I is the position of the LAST period in FILE_NAME, and J is the ! position of the last nonblank character following the period. ! implicit none character ( len = * ) file_name integer ( kind = 4 ) i integer ( kind = 4 ) j integer ( kind = 4 ) s_index_last_c i = s_index_last_c ( file_name, '.' ) if ( i == -1 ) then j = -1 else j = len_trim ( file_name ) end if return end subroutine filename_ext_swap ( file_name, ext ) !*****************************************************************************80 ! !! FILENAME_EXT_SWAP replaces the current "extension" of a file name. ! ! Discussion: ! ! The "extension" of a filename is the string of characters ! that appears after the LAST period in the name. A file ! with no period, or with a period as the last character ! in the name, has a "null" extension. ! ! Example: ! ! Input Output ! ================ ========= ! FILE_NAME EXT FILE_NAME ! ! bob.for obj bob.obj ! bob.bob.bob txt bob.bob.txt ! bob yak bob.yak ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 09 August 1999 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, character ( len = * ) FILE_NAME, a file name. ! On output, the extension of the file has been changed. ! ! Input, character ( len = * ) EXT, the extension to be used on the output ! copy of FILE_NAME, replacing the current extension if any. ! implicit none character ( len = * ) ext character ( len = * ) file_name integer ( kind = 4 ) i integer ( kind = 4 ) j integer ( kind = 4 ) len_max integer ( kind = 4 ) len_name len_max = len ( file_name ) len_name = len_trim ( file_name ) call filename_ext_get ( file_name, i, j ) if ( i == -1 ) then if ( len_max < len_name + 1 ) then return end if len_name = len_name + 1 file_name(len_name:len_name) = '.' i = len_name + 1 else i = i + 1 file_name(i:j) = ' ' end if file_name(i:) = ext return end subroutine get_unit ( iunit ) !*****************************************************************************80 ! !! GET_UNIT returns a free FORTRAN unit number. ! ! Discussion: ! ! A "free" FORTRAN unit number is an integer between 1 and 99 which ! is not currently associated with an I/O device. A free FORTRAN unit ! number is needed in order to open a file with the OPEN command. ! ! If IUNIT = 0, then no free FORTRAN unit could be found, although ! all 99 units were checked (except for units 5, 6 and 9, which ! are commonly reserved for console I/O). ! ! Otherwise, IUNIT is an integer between 1 and 99, representing a ! free FORTRAN unit. Note that GET_UNIT assumes that units 5 and 6 ! are special, and will never return those values. ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 18 September 2005 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Output, integer ( kind = 4 ) IUNIT, the free unit number. ! implicit none integer ( kind = 4 ) i integer ( kind = 4 ) ios integer ( kind = 4 ) iunit logical lopen iunit = 0 do i = 1, 99 if ( i /= 5 .and. i /= 6 .and. i /= 9 ) then inquire ( unit = i, opened = lopen, iostat = ios ) if ( ios == 0 ) then if ( .not. lopen ) then iunit = i return end if end if end if end do return end function 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: ! ! 06 December 2003 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) S, the string to be searched. ! ! Input, character C, the character to search for. ! ! Output, integer ( kind = 4 ) S_INDEX_LAST_C, the index in S where C occurs ! last, or -1 if it does not occur. ! implicit none character c integer ( kind = 4 ) i character ( len = * ) s integer ( kind = 4 ) s_len integer ( kind = 4 ) s_index_last_c if ( c == ' ' ) then s_len = len ( s ) else s_len = len_trim ( s ) end if do i = s_len, 1, -1 if ( s(i:i) == c ) then s_index_last_c = i return end if end do s_index_last_c = -1 return end subroutine timestamp ( ) !*****************************************************************************80 ! !! TIMESTAMP prints the current YMDHMS date as a time stamp. ! ! Example: ! ! 31 May 2001 9:45:54.872 AM ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 18 May 2013 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! None ! implicit none character ( len = 8 ) ampm integer ( kind = 4 ) d integer ( kind = 4 ) h integer ( kind = 4 ) m integer ( kind = 4 ) mm character ( len = 9 ), parameter, dimension(12) :: month = (/ & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' /) integer ( kind = 4 ) n integer ( kind = 4 ) s integer ( kind = 4 ) values(8) integer ( kind = 4 ) y call date_and_time ( values = values ) y = values(1) m = values(2) d = values(3) h = values(5) n = values(6) s = values(7) mm = values(8) if ( h < 12 ) then ampm = 'AM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Noon' else ampm = 'PM' end if else h = h - 12 if ( h < 12 ) then ampm = 'PM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Midnight' else ampm = 'AM' end if end if end if write ( *, '(i2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm ) return end