program pre4

	implicit none

	external p,pol,dpol

cºººles matrius estan definides grans per a assegurar que les dades hi caben

	double precision p,a,b,h,t,pmat(1:200),x(1:200),dapr(1:200),pol,

     +eps,xarrel,a1,b1,xarrel1,dpol,xini(1:5),x0,xarrel3

	integer intervals,j,niter,i

	common/dades/t


	open(1,file='P3-19pres.dat')
C apartat 1

	write(1,100) '#v',"p'(v)",'p(v)'
	a=1.d0/3.d0+0.1d0
	b=4.d0
	t=0.92d0
	intervals=80
	h=(a-b)/dble(intervals)

	do j=1,intervals

	  x(j)=a+j*h

	  pmat(j)=p(x(j))

	enddo

	call defunt1(intervals,pmat,x,dapr)



cºººaquest bucle nomes escriu a l'arxiu

	do j=1,intervals

	  write(1,101) x(j),dapr(j),pmat(j)

	enddo



100	format(a,15x,a,12x,a)

101	format(e15.8,2x,e15.8,2x,e15.8)



c-------------------------------------------------------------------------



c-------

	write(1,*)

	write(1,*)













cºººsubrutina de derivacio analitica

	subroutine defunt1(ndat,funci,x,dfunci)

	implicit none

	double precision x(ndat),funci(ndat),dfunci(ndat),h

	integer ndat,k



	h=x(2)-x(1)

cºººels dos extrems, 1 i ndat, corresponents a els limits de l'interval, tenen una formula diferent, els escric fora del bucle

	dfunci(1)=(funci(2)-funci(1))/h

	dfunci(ndat)=(funci(ndat)-funci(ndat-1))/h

	do k=2,ndat-1

	  dfunci(k)=(funci(k+1)-funci(k-1))/(2.d0*h)

	enddo



	end subroutine



c-------------------------------------------------------------------------

cºººequacio de van der waals

	double precision function p(x)

	implicit none

	double precision x,t

	common/dades/t



	p=8.d0*t/(3.d0*x-1.d0)-3.d0/x**2.d0



	return

	end function



c-------------------------------------------------------------------------

cºººpolinomi apartat 2

	double precision function pol(x)

	implicit none

	double precision x,t

	common/dades/t



	pol=4.d0*t*x**3.d0-9.d0*x**2.d0+6.d0*x-1.d0



	return

	end function



cºººderivada del polinomi

	double precision function dpol(x)

	implicit none

	double precision x,t

	common/dades/t



	dpol=12.d0*t*x**2.d0-18.d0*x+6.d0



	return

	end function



c-------------------------------------------------------------------------

cºººbiseccio

	subroutine bit1(a,b,eps,niter,fun,xarrel)

	implicit none

	external fun,dfun

	double precision a,b,eps,xarrel,error,xt,fun

	integer niter



	error=1000.d0

	niter=0



cºººsi no hi ha cap zero en l'interval, termina el proces

	if(fun(a)*fun(b).gt.0.d0)then

	  write(*,*) 'en aquest interval no hi ha cap zero (o hi ha un num

     +ero parell de zeros)'

	  goto 666

	endif



	do while(error.gt.eps)

	  xt=(a+b)/2.d0

	  niter=niter+1

cºººsi f(a) i f(xt) son del mateix signe, posem l'a on abans hi era el xt, 'estretant' el rang

cºººsi no son del mateix signe, significa que hi ha un 0 entre ells, i el que era xt ara es b, estretant el rang

	  if(fun(a)*fun(xt).gt.0.d0)a=xt

	  if(fun(a)*fun(xt).lt.0.d0)b=xt

cºººen el cas de que casualment xt resulta ser un 0, iguala 'a' i 'b' a aquest valor per a que l'error doni 0 i es pari el bucle

	  if(fun(xt).eq.0) then

	    a=xt

	    b=xt

	  endif

	  error=dabs(a-b)

	enddo

	xarrel=a



666	end subroutine



c-------------------------------------------------------------------------

cºººnewton rhapson



	subroutine nrt1(x0,eps,niter,fun,dfun,xarrel)

	implicit none

	external fun,dfun

	double precision x0,eps,xarrel,error,xt,fun,dfun

	integer niter



	error=1000.d0

	niter=0

	do while(error.gt.eps)

	  xt=x0-fun(x0)/dfun(x0)

	  niter=niter+1

	  error=dabs(xt-x0)

	  x0=xt

	enddo

	xarrel=x0



	end subroutine