! Purpose: ! To evaluate a sinc function with any coefficient A ! ! Author Date Description of Change ! ================ =========== ======================== ! Alexander Sage 01/13/12 original code ! program sinc_func implicit none integer, parameter :: dpt = kind (1.0d0) character (len=5) :: choose real (kind=dpt) :: x real (kind=dpt) :: A write(*,*) "This program evaluates the value of a simple A*sinc(x) function" write(*,*) "where A is any coefficient" write(*,*) "input a value for A now" read(*,*) A write(*,*) "would you like to use variations of pi for the x value?" read(*,*) choose do while ((choose /= 'no').and.(choose /= 'yes')) !this loops until the user inputs either yes or no write (*,*) "invalid entry please try again" write(*,*) "would you like to use variations of pi for the x value?" read(*,*) choose end do if (choose == 'no') then !if the user decides not to use a variation of pi write(*,*) "please write a value for x" !the program immediately asks for the x value read(*,*) x !and goes straight to the last subroutine call sub_no(A, x) else if (choose == 'yes') then !if the user chooses yes then the program takes call sub_yes(x) !the variation of pi and turns it into a decimal call sub_no(A, x) !then goes to the last subroutine end if stop end program sinc_func !************************************************** subroutine sub_yes(x) !this subroutine is only in use if the user implicit none !decides to use a variation of pi integer, parameter :: dpt = kind (1.0d0) real (kind=dpt), parameter :: pi = 3.14159265_dpt real (kind=dpt), intent(out) :: x real (kind=dpt) :: b write(*,*) "the value of x will be interpreted as pi multiplied by some constant" write(*,*) "input that constant" read(*,*) b x = b*pi !the constant the user has input is multiplied by pi write(*,*) "the value of x=", x !and set as x return end subroutine sub_yes !******************************************************** subroutine sub_no(A, x) !this subroutine is the final one and calls the function implicit none !that actually evaluates the numbers for x and A to give !and answer integer, parameter :: dpt = kind (1.0d0) real (kind=dpt), intent(in) :: x real (kind=dpt), intent(in) :: A real (kind=dpt) :: ans real (kind=dpt) :: sinc if (abs(x) > 1.1E-30_dpt) then ans = sinc(x, A) write(*,'(1x,A,F8.5)') "A*sinc(x) =", ans else if (abs(x) <= 1.0E-30_dpt) then !here the code has to account for a possible divide ans = A*1.0_dpt !by 0 error. to make sure the compiler doesn't write(*,'(1x,A,F8.5)') "A*sinc(x) =", ans !simply round off to 0, the program sets all values else !sinc(x) where x is close to 0 sinc(x)=1 write(*,*) "I appologize, the program malfunctioned" write(*,*) "perhaps try slightly different numbers" end if return end subroutine sub_no !******************************************* function sinc(x, A) !this function below is where sinc is defined as implicit none !sin(x)/x integer, parameter :: dpt = kind (1.0d0) real (kind=dpt) :: sinc real (kind=dpt), intent(in) :: A real (kind=dpt), intent(in) :: x sinc = (A*sin(x))/x return end function sinc