objective_function.f90

Go to the documentation of this file.

subroutine objective_function(n,x,f)
implicit none
integer, parameter :: rk = kind(1.0d0)
integer, intent(in) :: n
real(kind=rk), dimension(n), intent(in) :: x
real(kind=rk), intent(out) :: f

real(kind=rk), dimension(2) :: fullx
integer :: mpi_rank,mpi_err
include 'mpif.h'
integer :: status(mpi_status_size)


call mpi_comm_rank(mpi_comm_world,mpi_rank,mpi_err)

select case(mpi_rank)
case(0)
   fullx(1) = x(1)
   call mpi_send(fullx(1),1,mpi_double_precision,1,1,mpi_comm_world&
        &,mpi_err)
   call mpi_recv(fullx(2),1,mpi_double_precision,1,1,mpi_comm_world&
        &,status,mpi_err)
case(1)
   fullx(2) = x(1)
   call mpi_recv(fullx(1),1,mpi_double_precision,0,1,mpi_comm_world&
        &,status,mpi_err)
   call mpi_send(fullx(2),1,mpi_double_precision,0,1,mpi_comm_world&
        &,mpi_err)
case default
   print*,'too many processes launched for the model. Error'
   stop
end select

! Rosenbrock function
f = 100.*((fullx(2) - fullx(1)**2)**2) + (1. - fullx(1))**2

end subroutine objective_function