program main c*****************************************************************************80 c cc correlation_heat_map() creates a heat map of correlation matrix data. c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 24 April 2025 c c Author: c c John Burkardt c implicit none double precision cmax double precision cmin character ( len = 80 ) command_filename integer command_unit double precision xmax double precision xmin double precision ymax double precision ymin call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'correlation_heat_map():' write ( *, '(a)' ) ' Fortran77 version' write ( *, '(a)' ) & ' Heat map of a correlation matrix using gnuplot().' cmin = 0.28 cmax = 1.00 call get_unit ( command_unit ) command_filename = 'correlation_heat_map_commands.txt' open ( unit = command_unit, file = command_filename, & status = 'replace' ) write ( command_unit, '(a)' ) '# ' // trim ( command_filename ) write ( command_unit, '(a)' ) '#' write ( command_unit, '(a)' ) '# Usage:' write ( command_unit, '(a)' ) '# gnuplot < ' // & trim ( command_filename ) write ( command_unit, '(a)' ) '#' write ( command_unit, '(a)' ) 'set term png' write ( command_unit, '(a)' ) & 'set output "correlation_heat_map.png"' write ( command_unit, '(a)' ) & 'set title "Heat map of correlation matrix"' write ( command_unit, '(a)' ) 'unset key' write ( command_unit, '(a)' ) 'set tic scale 0' write ( command_unit, '(a)' ) 'set palette rgbformula 21, 22, 23' write ( command_unit, '(a,f8.2,a,f8.2,a)' ) & 'set cbrange [', cmin, ':', cmax, ']' write ( command_unit, '(a)' ) 'unset cbtics' c c These relate to the 1x8 range of i and j. c xmin = -0.5 xmax = 7.5 ymin = -0.5 ymax = 7.5 write ( command_unit, '(a,f8.2,a,f8.2,a)' ) & 'set xrange [', xmin, ':', xmax, ']' write ( command_unit, '(a,f8.2,a,f8.2,a)' ) & 'set yrange [', ymax, ':', ymin, ']' write ( command_unit, '(a)' ) 'set size square' write ( command_unit, '(a)' ) 'set view map' write ( command_unit, '(a)' ) & 'splot "correlation_data.txt" matrix with image' write ( command_unit, '(a)' ) 'quit' close ( unit = command_unit ) write ( *, '(a)' ) ' Created command file "' // & trim ( command_filename ) // '".' c c Terminate. c write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'correlation_heat_map():' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) '' call timestamp ( ) stop end subroutine get_unit ( iunit ) c*********************************************************************72 c cc get_unit() returns a free Fortran unit number. c c Discussion: c c A "free" Fortran unit number is a value between 1 and 99 which c is not currently associated with an I/O device. A free Fortran unit c number is needed in order to open a file with the OPEN command. c c If IUNIT = 0, then no free Fortran unit could be found, although c all 99 units were checked (except for units 5, 6 and 9, which c are commonly reserved for console I/O). c c Otherwise, IUNIT is a value between 1 and 99, representing a c free Fortran unit. The code assumes that units 5 and 6 c are special, and will never return those values. c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 02 September 2013 c c Author: c c John Burkardt c c Output: c c integer IUNIT, the free unit number. c implicit none integer i integer iunit logical value iunit = 0 do i = 1, 99 if ( i .ne. 5 .and. i .ne. 6 .and. i .ne. 9 ) then inquire ( unit = i, opened = value, err = 10 ) if ( .not. value ) then iunit = i return end if end if 10 continue end do return end subroutine r8vec_linspace ( n, a, b, x ) c*****************************************************************************80 c cc r8vec_linspace() creates a vector of linearly spaced values. c c Discussion: c c An R8VEC is a vector of R8's. c c 4 points evenly spaced between 0 and 12 will yield 0, 4, 8, 12. c c In other words, the interval is divided into N-1 even subintervals, c and the endpoints of intervals are used as the points. c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 14 March 2011 c c Author: c c John Burkardt c c Input: c c integer N, the number of entries in the vector. c c double precision A_FIRST, A_LAST, the first and last entries. c c Output: c c double precision X(N), a vector of linearly spaced data. c implicit none integer n double precision a double precision b integer i double precision x(n) if ( n == 1 ) then x(1) = ( a + b ) / 2.0D+00 else do i = 1, n x(i) = ( dble ( n - i ) * a & + dble ( i - 1 ) * b ) & / dble ( n - 1 ) end do end if return end subroutine timestamp ( ) c*********************************************************************72 c cc timestamp() prints the YMDHMS date as a timestamp. c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 12 June 2014 c c Author: c c John Burkardt c implicit none character * ( 8 ) ampm integer d character * ( 8 ) date integer h integer m integer mm character * ( 9 ) month(12) integer n integer s character * ( 10 ) time integer y save month data month / & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' / call date_and_time ( date, time ) read ( date, '(i4,i2,i2)' ) y, m, d read ( time, '(i2,i2,i2,1x,i3)' ) h, n, s, mm if ( h .lt. 12 ) then ampm = 'AM' else if ( h .eq. 12 ) then if ( n .eq. 0 .and. s .eq. 0 ) then ampm = 'Noon' else ampm = 'PM' end if else h = h - 12 if ( h .lt. 12 ) then ampm = 'PM' else if ( h .eq. 12 ) then if ( n .eq. 0 .and. s .eq. 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