program main

 implicit none

 real*8                :: r,f,ref,fref,check,norm,fnorm
 real*8                :: maxv,minv,diff,iv,tmp(3)
 real*8, allocatable   :: b(:),c(:)
 
 integer               :: k,ndim,np,ntmp,i,j,na
 integer, allocatable  :: a(:,:)

 type list
      real*8                :: el 
      type (list), pointer  :: next
 end type list

 type (list), pointer  :: head,tail,ptr

 !1)
 do
   read(*,*) r 
   if (r.gt.0.d0) exit
 enddo

 !2)
 np=10
 ref=fref(r)
 do
   call compute_int(f,np,iv,r)
   check=abs(iv-ref)
   if (check.le.1.d-4) exit
   np=np+10
 enddo
 write(*,'("Reference value", F12.5)') ref 
 write(*,'("Numerical value", F12.5, " with points: ", I5)')iv,np 
 write(*,'("Error", F12.5)') check 

 !3)
 ndim=int(iv)
 allocate(b(ndim))
 do i=1,ndim
    b(i)=f(dsqrt(dble(i)))
 enddo
 if (iv.gt.r) then
    call compute_norm(ndim,b,norm)
    write(*,'("Norm of b", F12.5)') norm 
 else
    ntmp=0
    do i=1,ndim
       if (b(i).gt.0.d0) ntmp=ntmp+1 
    enddo
    allocate(c(ntmp))
    k=0
    do i=1,ndim
       if (b(i).gt.0.d0) then
          k=k+1
          c(k)=b(i)
       endif        
    enddo
    norm=fnorm(ntmp,c)
    write(*,'("Norm of c", F12.5)') norm
 endif        

 !4)
 tmp(1)=iv
 tmp(2)=norm
 tmp(3)=r**2
 nullify(head,tail)
 do i=1,3
  if (.not.associated(head)) then
     allocate(head)
     tail => head
     nullify(tail%next)
     tail%el=tmp(i)
  else
     allocate(tail%next)
     tail => tail%next
     nullify(tail%next)
     tail%el=tmp(i)
  endif
 enddo

 open(10,file='list.dat')
 ptr => head
 do
   if (.not.associated(ptr)) exit
   write(10,100) ptr%el
   ptr => ptr%next
 enddo
 close(10)

 !5)
 na=int(r)
 allocate(a(na,na))
 do i=1,na
    do j=1,na
       a(i,j)=int(iv/dble((2*(i+j))))
    enddo
 enddo   
 
 maxv=-1.d10
 minv=1.d10
 do i=1,na
    do j=1,na
       if (a(i,j).gt.maxv) maxv=a(i,j)
       if (a(i,j).lt.minv) minv=a(i,j)
    enddo   
 enddo
 diff=maxv-minv

 if (iv.gt.r) then
    do i=1,na,2
       call sortp(na,a(:,i))
    enddo     
 else
    do i=2,na,2
       call sortm(na,a(i,:))
    enddo 
 endif        

 !6)
 open(11,file='a.dat')
 do i=1,na
    do j=1,na
       write(11,101) i,j,a(i,j)
    enddo   
 enddo   

 if (diff.gt.4.d0*r) then
    open(12,file='b.dat')
    do i=1,ndim
       write(12,102) i,b(i)
    enddo
 else
    open(12,file='c.dat')      
    do i=1,ntmp
       write(12,102) i,c(i)    
    enddo        
    deallocate(c)
 endif   
 close(11)
 close(12)

 deallocate(a)
 deallocate(b)

 stop

100 format(F14.8)
101 format(3(I5))
102 format(I5,F14.8)

end program main


real*8 function f(x)

 implicit none

 real*8, intent(in)  :: x

 f=x**2+x-5.d0

 return 

end function f

real*8 function fref(x)

 implicit none

 real*8, intent(in)  :: x

 fref=x**3/3.d0+x**2/2.d0-5.d0*x

 return

end function fref


subroutine compute_int(f,n,iv,r)

 implicit none

 integer,  intent(in)  :: n
 real*8,   intent(in)  :: r
 real*8,   intent(out) :: iv

 integer               :: i
 real*8                :: h,x,f

 h=r/dble(n)

 iv=f(0.d0)+f(r)
 iv=0.50*iv
 do i=1,n-1
    x=i*h
    iv=iv+f(x)
 enddo 
 iv=iv*h

 return

end subroutine compute_int


subroutine compute_norm(n,b,norm)

 implicit none

 integer,   intent(in)  :: n
 real*8,    intent(in)  :: b(n)
 real*8,    intent(out) :: norm 

 integer                :: i

 norm=0.d0
 do i=1,n
    norm=norm+b(i)**2
 enddo   
 norm=dsqrt(norm)
  
 return

end subroutine compute_norm 

       
real*8 function fnorm(n,b)

 implicit none

 integer,   intent(in)  :: n
 real*8,    intent(in)  :: b(n)

 integer                :: i

 fnorm=0.d0
 do i=1,n
    fnorm=fnorm+b(i)**2
 enddo
 fnorm=dsqrt(fnorm)

 return

end function fnorm


subroutine sortp(na,aa)

  implicit none

  integer,   intent(in)    :: na
  integer,   intent(inout) :: aa(na)

  integer                  :: i,j
  integer                  :: tmp

  do i=1,na-1
    do j=2,na-(i-1)
       if (aa(j-1).gt.aa(j)) then
          tmp=aa(j-1)
          aa(j-1)=aa(j)
          aa(j)=tmp
       endif
    enddo
 enddo

 return

end subroutine sortp


subroutine sortm(na,aa)

  implicit none

  integer,   intent(in)    :: na
  integer,   intent(inout) :: aa(na)

  integer                  :: i,j
  integer                  :: tmp

  do i=1,na-1
    do j=2,na-(i-1)
       if (aa(j-1).lt.aa(j)) then
          tmp=aa(j-1)
          aa(j-1)=aa(j)
          aa(j)=tmp
       endif
    enddo
 enddo

 return

end subroutine sortm