program TraceExponential
!-----------------------------------------------------------------------
!Christina Urbanczyk Lab5 February 16, 2010
! This algorithm uses a factorial subprogram to calculate the &
! approximate value of exp(x) using the infinite series.
! Variables used are:
! count: DO-loop control variable
! FactorialNum: function subprogram to calculate factorials
! X: User determined value to find infinite series of
! Numits:Number of iterations
! Countits: Count iterations
! Tol:Convergence criteria
! Esum:Sum of Exp(x)
! Number:Subprogram variable
! FactorialNum:Factorial of integer
!
! Input:X,Tol,Numits
! Output:FactorialNum
!-----------------------------------------------------------------------
IMPLICIT NONE
integer ,parameter :: dp = selected_real_kind ( 15 ) !15 significant figures
integer :: count , Numits,Countits
real ( dp) :: X , Esum, Tol
character (len=1):: Method
Esum= 1
write( * ,* ) "Please enter a value that you would like to find the infinite series of:"
read( * ,* ) X
write( * ,* ) "Would you like to define the number of iterations (Y or N)?"
read ( * ,* ) Method
IF ( Method == "Y" .OR . Method== "y" ) THEN
write ( * ,* ) "What is your number of iterations?"
read ( * ,* ) Numits
!Display Trace Table
write ( * ,'(T1,A7,T20,A9,T43,A8,T58,A5,T73,A6/)' ) "Count" ,"X^count" ,"Count!" ,"Esum" ,"Exp(X)"
DO count = 1 ,Numits
Esum= Esum+ ( x** count ) / ( real ( FactorialNum( Count ) ) )
write( * ,'(T1,I2,T7,F20.1,T30,F20.1,T51,F15.5,T67,F15.5)' ) count ,X** count ,FactorialNum( Count ) ,Esum, exp ( X)
END DO
write( * ,* ) "Given" ,Numits,"iterations, the estimated value is" ,Esum,"."
write( * ,* ) "The estimated value had" ,abs ( exp ( X) - Esum) / exp ( X) * 100.0 ,"% error from the actual value of" ,exp ( x)
ELSE IF ( Method == "N" .OR . Method == "n" ) THEN
write ( * ,* ) "What is your convergence criteria?"
read ( * ,* ) Tol
!Display Trace Table
write ( * ,'(T1,A7,T20,A9,T40,A8,T58,A5,T73,A6/)' ) "Count" ,"X^count" ,"Count!" ,"Esum" ,"Exp(X)"
DO count = 1 ,Countits
Esum= Esum+ ( x** count ) / ( real ( FactorialNum( Count ) ) )
write( * ,'(T1,I2,T7,F20.1,T30,F20.1,T51,F15.5,T67,F15.5)' ) count ,X** count ,FactorialNum( Count ) ,Esum, exp ( X)
IF ( ( abs ( exp ( X) - Esum) ) <Tol) EXIT
Countits= Countits+ 1
END DO
write( * ,* ) "Given a tolerance of" ,Tol,"it took" ,Countits,"iterations."
write( * ,* ) "The estimated value had" ,abs ( exp ( X) - Esum) / exp ( X) * 100.0
write( * ,* ) "% error from the actual value of" ,exp ( x) ,"."
ELSE
write( * ,* ) "Please define iterations or convergence criteria."
END IF
CONTAINS
!--FactorialNum--------------------------------------------------------
! This program calculates the factorial Number! of Number which is 1 &
! if Number=0, 1*2*...*Number if Number>0.
!
! Accepts:Number
! Returns:FactorialNum
!----------------------------------------------------------------------
FUNCTION FactorialNum ( Number )
Integer , INTENT ( IN ) :: Number
Integer :: count
real :: FactorialNum
!Calculate FactorialNum
FactorialNum= 1
DO count = 2 , Number
FactorialNum= FactorialNum* count
END DO
END FUNCTION FactorialNum
END
cHJvZ3JhbSBUcmFjZUV4cG9uZW50aWFsICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAohLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0KIUNocmlzdGluYSBVcmJhbmN6eWsgICAgICAgICAgICAgTGFiNSAgICAgICAgICAgICAgIEZlYnJ1YXJ5IDE2LCAyMDEwICAgCiEgVGhpcyBhbGdvcml0aG0gdXNlcyBhIGZhY3RvcmlhbCBzdWJwcm9ncmFtIHRvIGNhbGN1bGF0ZSB0aGUgJiAgICAgICAgIAohIGFwcHJveGltYXRlIHZhbHVlIG9mIGV4cCh4KSB1c2luZyB0aGUgaW5maW5pdGUgc2VyaWVzLiAgICAgICAgICAgICAgICAKISAgICBWYXJpYWJsZXMgdXNlZCBhcmU6ICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiEgICAgY291bnQ6IERPLWxvb3AgY29udHJvbCB2YXJpYWJsZSAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAohICAgIEZhY3RvcmlhbE51bTogZnVuY3Rpb24gc3VicHJvZ3JhbSB0byBjYWxjdWxhdGUgZmFjdG9yaWFscyAgICAgICAgICAKISAgICBYOiBVc2VyIGRldGVybWluZWQgdmFsdWUgdG8gZmluZCBpbmZpbml0ZSBzZXJpZXMgb2YgICAgICAgICAgICAgICAgCiEgICAgTnVtaXRzOk51bWJlciBvZiBpdGVyYXRpb25zICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAohICAgIENvdW50aXRzOiBDb3VudCBpdGVyYXRpb25zICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKISAgICBUb2w6Q29udmVyZ2VuY2UgY3JpdGVyaWEgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiEgICAgRXN1bTpTdW0gb2YgRXhwKHgpICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAohICAgIE51bWJlcjpTdWJwcm9ncmFtIHZhcmlhYmxlICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKISAgICBGYWN0b3JpYWxOdW06RmFjdG9yaWFsIG9mIGludGVnZXIgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiEgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIAohIElucHV0OlgsVG9sLE51bWl0cyAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKISBPdXRwdXQ6RmFjdG9yaWFsTnVtICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCiEtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLQoKSU1QTElDSVQgTk9ORQppbnRlZ2VyLHBhcmFtZXRlcjo6ZHA9c2VsZWN0ZWRfcmVhbF9raW5kKDE1KSAhMTUgc2lnbmlmaWNhbnQgZmlndXJlcyAKaW50ZWdlcjo6IGNvdW50LCBOdW1pdHMsQ291bnRpdHMgICAgICAgICAgICAgICAgICAgICAgICAgICAgIApyZWFsKGRwKTo6WCwgRXN1bSwgVG9sICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAKY2hhcmFjdGVyIChsZW49MSk6OiBNZXRob2QgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCgpFc3VtPTEKCndyaXRlKCosKikgIlBsZWFzZSBlbnRlciBhIHZhbHVlIHRoYXQgeW91IHdvdWxkIGxpa2UgdG8gZmluZCB0aGUgaW5maW5pdGUgc2VyaWVzIG9mOiIKcmVhZCgqLCopIFgKCndyaXRlKCosKikgIldvdWxkIHlvdSBsaWtlIHRvIGRlZmluZSB0aGUgbnVtYmVyIG9mIGl0ZXJhdGlvbnMgKFkgb3IgTik/IgogICByZWFkICgqLCopIE1ldGhvZAogSUYgKE1ldGhvZCA9PSAiWSIgLk9SLiBNZXRob2Q9PSAieSIpIFRIRU4KICAgd3JpdGUgKCosKikgIldoYXQgaXMgeW91ciBudW1iZXIgb2YgaXRlcmF0aW9ucz8iCiAgIHJlYWQgKCosKikgTnVtaXRzCgohRGlzcGxheSBUcmFjZSBUYWJsZQp3cml0ZSAoKiwnKFQxLEE3LFQyMCxBOSxUNDMsQTgsVDU4LEE1LFQ3MyxBNi8pJykgIkNvdW50IiwiWF5jb3VudCIsIkNvdW50ISIsIkVzdW0iLCJFeHAoWCkiCiAgICAgIERPIGNvdW50PTEsTnVtaXRzCiAgICAgICAgICBFc3VtPSBFc3VtKyh4Kipjb3VudCkvKHJlYWwoRmFjdG9yaWFsTnVtKENvdW50KSkpCiAgICAgICB3cml0ZSgqLCcoVDEsSTIsVDcsRjIwLjEsVDMwLEYyMC4xLFQ1MSxGMTUuNSxUNjcsRjE1LjUpJykgY291bnQsWCoqY291bnQsRmFjdG9yaWFsTnVtKENvdW50KSxFc3VtLCBleHAoWCkKICAgICAgRU5EIERPCiAgICAgICAgd3JpdGUoKiwqKSAiR2l2ZW4iLE51bWl0cywiaXRlcmF0aW9ucywgdGhlIGVzdGltYXRlZCB2YWx1ZSBpcyIsRXN1bSwiLiIKICAgICAgICB3cml0ZSgqLCopICJUaGUgZXN0aW1hdGVkIHZhbHVlIGhhZCIsYWJzKGV4cChYKS1Fc3VtKS9leHAoWCkqMTAwLjAsIiUgZXJyb3IgZnJvbSB0aGUgYWN0dWFsIHZhbHVlIG9mIixleHAoeCkKICAgRUxTRSBJRiAgKE1ldGhvZCA9PSAiTiIgLk9SLiBNZXRob2QgPT0gIm4iKSBUSEVOCiAgICAgICAgd3JpdGUgKCosKikgIldoYXQgaXMgeW91ciBjb252ZXJnZW5jZSBjcml0ZXJpYT8iCiAgICAgICAgcmVhZCAoKiwqKSBUb2wKCiFEaXNwbGF5IFRyYWNlIFRhYmxlCndyaXRlICgqLCcoVDEsQTcsVDIwLEE5LFQ0MCxBOCxUNTgsQTUsVDczLEE2LyknKSAiQ291bnQiLCJYXmNvdW50IiwiQ291bnQhIiwiRXN1bSIsIkV4cChYKSIKICAgICAgRE8gY291bnQ9MSxDb3VudGl0cwogICAgICBFc3VtPSBFc3VtKyh4Kipjb3VudCkvKHJlYWwoRmFjdG9yaWFsTnVtKENvdW50KSkpCiAgICAgIHdyaXRlKCosJyhUMSxJMixUNyxGMjAuMSxUMzAsRjIwLjEsVDUxLEYxNS41LFQ2NyxGMTUuNSknKSBjb3VudCxYKipjb3VudCxGYWN0b3JpYWxOdW0oQ291bnQpLEVzdW0sIGV4cChYKQogICAgICBJRiAoKGFicyhleHAoWCktRXN1bSkpPFRvbCkgRVhJVAogICAgICBDb3VudGl0cz1Db3VudGl0cysxCiAgICAgIEVORCBETwogICAgICAgIHdyaXRlKCosKikgIkdpdmVuIGEgdG9sZXJhbmNlIG9mIixUb2wsIml0IHRvb2siLENvdW50aXRzLCJpdGVyYXRpb25zLiIKICAgICAgICB3cml0ZSgqLCopICJUaGUgZXN0aW1hdGVkIHZhbHVlIGhhZCIsYWJzKGV4cChYKS1Fc3VtKS9leHAoWCkqMTAwLjAKICAgICAgICB3cml0ZSgqLCopICIlIGVycm9yIGZyb20gdGhlIGFjdHVhbCB2YWx1ZSBvZiIsZXhwKHgpLCIuIgogICBFTFNFCiAgICAgICAgd3JpdGUoKiwqKSAiUGxlYXNlIGRlZmluZSBpdGVyYXRpb25zIG9yIGNvbnZlcmdlbmNlIGNyaXRlcmlhLiIKICAgRU5EIElGCgoKQ09OVEFJTlMKICEtLUZhY3RvcmlhbE51bS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tCiAhIFRoaXMgcHJvZ3JhbSBjYWxjdWxhdGVzIHRoZSBmYWN0b3JpYWwgTnVtYmVyISBvZiBOdW1iZXIgd2hpY2ggaXMgMSAmCiAhIGlmIE51bWJlcj0wLCAxKjIqLi4uKk51bWJlciBpZiBOdW1iZXI+MC4KICEKICEgQWNjZXB0czpOdW1iZXIKICEgUmV0dXJuczpGYWN0b3JpYWxOdW0KICEtLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tCiBGVU5DVElPTiBGYWN0b3JpYWxOdW0gKE51bWJlcikKIEludGVnZXIsIElOVEVOVCAoSU4pOjpOdW1iZXIKIEludGVnZXI6OmNvdW50CiByZWFsOjogRmFjdG9yaWFsTnVtCgogIUNhbGN1bGF0ZSBGYWN0b3JpYWxOdW0KIEZhY3RvcmlhbE51bT0xCiBETyBjb3VudD0yLCBOdW1iZXIKICAgIEZhY3RvcmlhbE51bT1GYWN0b3JpYWxOdW0qY291bnQKIEVORCBETwoKRU5EIEZVTkNUSU9OIEZhY3RvcmlhbE51bQoKCkVORA==