program main c*********************************************************************72 c cc sine_integral_test() tests sine_integral(). c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 19 November 2024 c c Author: c c John Burkardt c implicit none call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'sine_integral_test():' write ( *, '(a)' ) ' Fortran77 version' write ( *, '(a)' ) ' Test sine_integral().' call ci_test ( ) call si_test ( ) c c Terminate. c write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'sine_integral_test():' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) ' ' call timestamp ( ) stop 0 end subroutine ci_test ( ) c*********************************************************************72 c cc ci_test() tests ci(). c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 26 March 2025 c c Author: c c John Burkardt c implicit none double precision fx1 double precision fx2 integer n_data double precision si double precision x write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ci_test():' write ( *, '(a)' ) & ' ci() evaluates the Cosine Integral function CI(X).' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X CI(X)' write ( *, '(a)' ) ' ' n_data = 0 do call ci_values ( n_data, x, fx1 ) if ( n_data == 0 ) then exit end if call cisi ( x, fx2, si ) write ( *, '(2x,g14.6,2x,g24.16,g24.16)' ) x, fx1, fx2 end do return end subroutine ci_values ( n_data, x, fx ) c*********************************************************************72 c cc ci_values() returns some values of the cosine integral function. c c Discussion: c c The cosine integral is defined by c c CI(X) = - integral ( X <= T < +oo ) ( cos ( T ) ) / T dT c c In Mathematica, the function can be evaluated by: c c CosIntegral(x) c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 21 March 2007 c c Author: c c John Burkardt c c Reference: c c Milton Abramowitz, Irene Stegun, c Handbook of Mathematical Functions, c National Bureau of Standards, 1964, c ISBN: 0-486-61272-4, c LC: QA47.A34. c c Stephen Wolfram, c The Mathematica Book, c Fourth Edition, c Cambridge University Press, 1999, c ISBN: 0-521-64314-7, c LC: QA76.95.W65. c c Parameters: c c Input/output, integer N_DATA. The user sets N_DATA to 0 before the c first call. On each call, the routine increments N_DATA by 1, and c returns the corresponding data; when there is no more data, the c output value of N_DATA will be 0 again. c c Output, double precision X, the argument of the function. c c Output, double precision FX, the value of the function. c implicit none integer n_max parameter ( n_max = 16 ) double precision fx double precision fx_vec(n_max) integer n_data double precision x double precision x_vec(n_max) save fx_vec save x_vec data fx_vec / & -0.1777840788066129D+00, & -0.2227070695927976D-01, & 0.1005147070088978D+00, & 0.1982786159524672D+00, & 0.2760678304677729D+00, & 0.3374039229009681D+00, & 0.4204591828942405D+00, & 0.4620065850946773D+00, & 0.4717325169318778D+00, & 0.4568111294183369D+00, & 0.4229808287748650D+00, & 0.2858711963653835D+00, & 0.1196297860080003D+00, & -0.3212854851248112D-01, & -0.1409816978869304D+00, & -0.1934911221017388D+00 / data x_vec / & 0.5D+00, & 0.6D+00, & 0.7D+00, & 0.8D+00, & 0.9D+00, & 1.0D+00, & 1.2D+00, & 1.4D+00, & 1.6D+00, & 1.8D+00, & 2.0D+00, & 2.5D+00, & 3.0D+00, & 3.5D+00, & 4.0D+00, & 4.5D+00 / if ( n_data .lt. 0 ) then n_data = 0 end if n_data = n_data + 1 if ( n_max .lt. n_data ) then n_data = 0 x = 0.0D+00 fx = 0.0D+00 else x = x_vec(n_data) fx = fx_vec(n_data) end if return end subroutine si_test ( ) c*********************************************************************72 c cc si_test() tests si(). c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 26 March 2025 c c Author: c c John Burkardt c implicit none double precision ci double precision fx1 double precision fx2 integer n_data double precision x write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'si_test():' write ( *, '(a)' ) & ' si() evaluates the sine integral function.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' X SI(X)' write ( *, '(a)' ) ' ' n_data = 0 do call si_values ( n_data, x, fx1 ) if ( n_data == 0 ) then exit end if call cisi ( x, ci, fx2 ) write ( *, '(2x,g14.6,2x,g24.16,g24.16)' ) x, fx1, fx2 end do return end subroutine si_values ( n_data, x, fx ) c*********************************************************************72 c cc si_values() returns some values of the sine integral function. c c Discussion: c c SI(X) = integral ( 0 <= T <= X ) sin ( T ) / T dt c c In Mathematica, the function can be evaluated by: c c SinIntegral(x) c c Licensing: c c This code is distributed under the MIT license. c c Modified: c c 25 March 2007 c c Author: c c John Burkardt c c Reference: c c Milton Abramowitz, Irene Stegun, c Handbook of Mathematical Functions, c National Bureau of Standards, 1964, c ISBN: 0-486-61272-4, c LC: QA47.A34. c c Stephen Wolfram, c The Mathematica Book, c Fourth Edition, c Cambridge University Press, 1999, c ISBN: 0-521-64314-7, c LC: QA76.95.W65. c c Parameters: c c Input/output, integer N_DATA. The user sets N_DATA to 0 before the c first call. On each call, the routine increments N_DATA by 1, and c returns the corresponding data; when there is no more data, the c output value of N_DATA will be 0 again. c c Output, double precision X, the argument of the function. c c Output, double precision FX, the value of the function. c implicit none integer n_max parameter ( n_max = 16 ) double precision fx double precision fx_vec(n_max) integer n_data double precision x double precision x_vec(n_max) save fx_vec save x_vec data fx_vec / & 0.4931074180430667D+00, & 0.5881288096080801D+00, & 0.6812222391166113D+00, & 0.7720957854819966D+00, & 0.8604707107452929D+00, & 0.9460830703671830D+00, & 0.1108047199013719D+01, & 0.1256226732779218D+01, & 0.1389180485870438D+01, & 0.1505816780255579D+01, & 0.1605412976802695D+01, & 0.1778520173443827D+01, & 0.1848652527999468D+01, & 0.1833125398665997D+01, & 0.1758203138949053D+01, & 0.1654140414379244D+01 / data x_vec / & 0.5D+00, & 0.6D+00, & 0.7D+00, & 0.8D+00, & 0.9D+00, & 1.0D+00, & 1.2D+00, & 1.4D+00, & 1.6D+00, & 1.8D+00, & 2.0D+00, & 2.5D+00, & 3.0D+00, & 3.5D+00, & 4.0D+00, & 4.5D+00 / if ( n_data .lt. 0 ) then n_data = 0 end if n_data = n_data + 1 if ( n_max .lt. n_data ) then n_data = 0 x = 0.0D+00 fx = 0.0D+00 else x = x_vec(n_data) fx = fx_vec(n_data) 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