program sumatory c....... This program calculates the sumatory S=Sum(1/i) c **** NO use of subroutines **** c....... variables declaration implicit real*4(a-h,o-z) parameter (mxpoints=10000) !! npoints: points in x dimension sumasc(0:mxpoints+1),sumdesc(0:mxpoints+1) print*,'Sumatory of 1/i from 1 to Npoints' 50 print*,' ' print*,' give the number of points Npoints: (le.0 to exit)' read*,npoints c...... test for quit if (npoints.le.0) go to 500 c...... test for dimensions if (npoints.gt.mxpoints) then print*,' the maximum number of points should be '// + ' smaller than ',mxpoints go to 50 endif c....... initialization do 100 i=0,npoints+1 sumasc(i) = 0.0 sumdesc(i) = 0.0 100 continue c....... sumatory in ascendent order do 200 i=1,npoints sumasc(i) = sumasc(i-1) + 1.0/i 200 continue c....... sumatory in descendent order do 300 i=npoints,1,-1 sumdesc(i) = sumdesc(i+1) + 1.0/i 300 continue c....... print results open(unit=10,file='sumatoryns.dat',status='unknown') do 400 i=1,npoints write(10,425) i,sumasc(i),sumdesc(npoints-i+1) 400 continue close(unit=10) 425 format(5x,i6,2(5x,f15.6)) print*,'Sum(1/i) for ',npoints,': ascendent=:', + sumasc(npoints),' descendent=:',sumdesc(1) go to 50 500 stop end |
El programa sumatory podría estar mejor escrito si
usamos subrutinas.
En este caso, podriamos separar algunas etapas del mismo, como hicimos
en sumatorysub.f.
Allí separamos los siguientes pasos:
program sumatory c....... This program calculates the sumatory S=Sum(1/i) c **** WITH subroutines **** c....... variables declaration implicit real*4(a-h,o-z) parameter (mxpoints=10000) !! npoints: points in x common/blocksum/sumasc(0:mxpoints+1),sumdesc(0:mxpoints+1), + npoints ...... ...... c....... initialization call initialization c....... sumatory in ascendent order call sumascendent c....... sumatory in descendent order call sumdescendent c....... print results call printresults c....... print totals print*,'Sum(1/i) for ',npoints,': ascendent=:', + totasc,' descendent=:',totdesc go to 50 500 stop end c c--------------------------------------------------------------------- c subroutine initialization implicit real*4(a-h,o-z) c....... initialization of variables parameter (mxpoints=10000) common/blocksum/sumasc(0:mxpoints+1),sumdesc(0:mxpoints+1), + npoints do 100 i=0,npoints+1 sumasc(i) = 0.0 sumdesc(i) = 0.0 100 continue return end c c--------------------------------------------------------------------- c subroutine sumascendent implicit real*4(a-h,o-z) c....... sumatory in ascendent order parameter (mxpoints=10000) common/blocksum/sumasc(0:mxpoints+1),sumdesc(0:mxpoints+1), + npoints c....... sumatory in ascendent order do 200 i=1,npoints sumasc(i) = sumasc(i-1) + 1.0/i 200 continue return end c c--------------------------------------------------------------------- c subroutine sumdescendent implicit real*4(a-h,o-z) c....... sumatory in descendent order parameter (mxpoints=10000) common/blocksum/sumasc(0:mxpoints+1),sumdesc(0:mxpoints+1), + npoints do 300 i=npoints,1,-1 sumdesc(i) = sumdesc(i+1) + 1.0/i 300 continue return end c c--------------------------------------------------------------------- c subroutine printresults implicit real*4(a-h,o-z) c....... print results on 'sumatorys.dat' parameter (mxpoints=10000) common/blocksum/sumasc(0:mxpoints+1),sumdesc(0:mxpoints+1), + npoints open(unit=10,file='sumatorys.dat',status='unknown') do 400 i=1,npoints write(10,425) i,sumasc(i),sumdesc(npoints-i+1) 400 continue close(unit=10) 425 format(5x,i6,2(5x,f15.6)) c....... print totals totasc = sumasc(npoints) totdesc = sumdesc(1) return end c c--------------------------------------------------------------------- c |