program recursive_test ! !******************************************************************************* ! !! RECURSIVE_TEST demonstrates the use of recursive functions. ! implicit none ! integer f integer f_hofstadter integer i ! call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'RECURSIVE_TEST' write ( *, '(a)' ) ' Demonstrate the use of recursive function definitions.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' F_HOFSTADTER evaluates Hofstadter''s recursive' write ( *, '(a)' ) ' F function, and does so using an F90 recursive' write ( *, '(a)' ) ' function.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' N F(N)' write ( *, '(a)' ) ' ' do i = 0, 30 f = f_hofstadter ( i ) write ( *, '(2i6)' ) i, f end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'RECURSIVE_TEST:' write ( *, '(a)' ) ' Normal end of execution.' stop end recursive function f_hofstadter ( n ) result ( value ) ! !******************************************************************************* ! !! F_HOFSTADTER computes the Hofstadter F sequence. ! ! ! Discussion: ! ! F(N) = 0 if N = 0 ! = N - F ( N - 1 ), otherwise. ! ! F(N) is defined for all nonnegative integers, and turns out ! to be equal to int ( ( N + 1 ) / 2 ). ! ! Table: ! ! N F(N) ! -- ---- ! ! 0 0 ! 1 1 ! 2 1 ! 3 2 ! 4 2 ! 5 3 ! 6 3 ! 7 4 ! 8 4 ! 9 5 ! 10 5 ! 11 6 ! 12 6 ! 13 7 ! 14 7 ! 15 8 ! 16 8 ! 17 9 ! 18 9 ! 19 10 ! 20 10 ! 21 11 ! 22 11 ! 23 12 ! 24 12 ! 25 13 ! 26 13 ! 27 14 ! 28 14 ! 29 15 ! 30 15 ! ! Reference: ! ! Douglas Hofstadter, ! Goedel, Escher, Bach, ! Basic Books, 1979. ! ! Modified: ! ! 11 July 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer N, the argument of the function. ! ! Output, integer F_HOFSTADTER, the value of the function. ! implicit none ! integer n integer value ! if ( n <= 0 ) then value = 0 else value = n - f_hofstadter ( n-1 ) end if return end subroutine timestamp ( ) ! !******************************************************************************* ! !! TIMESTAMP prints the current YMDHMS date as a time stamp. ! ! ! Example: ! ! May 31 2001 9:45:54.872 AM ! ! Modified: ! ! 31 May 2001 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! None ! implicit none ! character ( len = 8 ) ampm integer d character ( len = 8 ) date integer h integer m integer mm character ( len = 9 ), parameter, dimension(12) :: month = (/ & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' /) integer n integer s character ( len = 10 ) time integer values(8) integer y character ( len = 5 ) zone ! call date_and_time ( date, time, zone, 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 ( *, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm ) return end