Monday, June 23, 2014

fotran learning notes 4--subroutine and function

Differences: the function is relative simple and just return one value. 
Subroutine will return all values in its variable list or may just operate something without input parameters. In addition, you have to call it.

function example
________________________________________________
program fn1
implicit none
real:: a,b,c,bigroot ! ! Program to demonstrate the use of a FUNCTION subprogram !
write(6,10) !!  write out on screen
read(5,*) a, b, c !! read from keyboard??
write(6,20) bigroot(a, b, c)
10 format(' Enter the coefficients a, b, c '/)
20 format(' The larger root is ',F12.6)
end program fn1
 ! ! End of main program

function bigroot(a, b, c)
implicit none
real:: bigroot, a, b, c, test, root1, root2
! ! Function to find largest root of a quadratic
! If no real roots then function returns value -9.0E35
test = b*b - 4.0*a*c
if(test.ge.0.0) then

   root1 = (-b + sqrt(test)) / (2.0 * a)
   root2 = (-b - sqrt(test)) / (2.0 * a)

  if(root2.gt.root1) then
   bigroot = root2
  else
   bigroot = root1
  end if

 else
  bigroot = -9.0e35
end if

return
end function bigroot


subroutine
----------------------------------------------------------------------------------------
program subrout1
implicit none
real:: a,b,c,root1,root2
logical:: realroots

write(*,10)
read(*,*) a,b,c

call solvit(a,b,c,root1,root2,realroots)

if (realroots) then
write(*,20) root1,root2
else
write(*,*) 'Sorry, there are no real roots'
endif
!
10 format('Enter 3 coefficients')
20 format('The roots are',2f12.6)
stop
end program

!subroutine solvit

subroutine solvit(a,b,c,root1,root2,realroots)
implicit none
real::a,b,c,root1,root2,test
logical::realroots

test=b**2 - 4*a*c

if(test>=0.0) then
root1 = (-b + sqrt(test))/(2.0*a)
root2 = (-b - sqrt(test))/(2.0*a)
realroots = .true.
else
realroots = .false.
end if
return
end

No comments:

Post a Comment