cgsub.f90

Go to the documentation of this file.

subroutine subroutine_cg(method,n,epsin,x,mpi_comm,mpi_size)
!
! Change the maximum size of the problem dimension here
!
implicit none
integer, parameter :: rk = kind(1.0d0)

integer, intent(in) :: method
integer, intent(in) :: n
real(kind=rk), intent(in) :: epsin
real(kind=rk), dimension(n), intent(inout) :: x
integer, intent(in) :: mpi_comm,mpi_size

real(kind=rk), dimension(n) :: g,d,gold,w
real(kind=rk) :: f,eps,tlev
real(kind=rk), parameter :: one=1.0d0
logical :: finish
integer :: iprint(2),iflag,icall,i!mp,lp,i
integer :: irest


finish= .false.
!
! Read problem input information
!
irest = 0 !no restarts
!irest = 1 !restarts every n steps  

!     IPRINT =  FREQUENCY AND TYPE OF PRINTING
!               IPRINT(1) < 0 : NO OUTPUT IS GENERATED
!               IPRINT(1) = 0 : OUTPUT ONLY AT FIRST AND LAST ITERATION
!               IPRINT(1) > 0 : OUTPUT EVERY IPRINT(1) ITERATIONS
!               IPRINT(2)     : SPECIFIES THE TYPE OF OUTPUT GENERATED;
!                               THE LARGER THE VALUE (BETWEEN 0 AND 3),
!                               THE MORE INFORMATION
!               IPRINT(2) = 0 : NO ADDITIONAL INFORMATION PRINTED
!       IPRINT(2) = 1 : INITIAL X AND GRADIENT VECTORS PRINTED
!       IPRINT(2) = 2 : X VECTOR PRINTED EVERY ITERATION
!       IPRINT(2) = 3 : X VECTOR AND GRADIENT VECTOR PRINTED 
!               EVERY ITERATION 
iprint(1) = 1 
iprint(2) = 0  
!
! Check for correct dimension value n
!
if (n .lt. 0) then
   iflag = -3
   write(*,850)
   go to 50
end if


!
! Print parameters
!
if (iprint(1) .ge. 0) then
   write(*,820)
   write(*,840) n, method, irest
end if

icall=0
!
! This is the convergence constant 
!
eps= epsin

! IFLAG=0 indicates an initial entry to program

iflag=0

!
! Begin counting CPU time. 
! (Note: This function may not work on all operating systems.)
!


20 CONTINUE
!
! Calculate the function and gradient values here
!
! Rosenbrock test function

call fcn(n,x,f,g)
30 CONTINUE
!
! Call the main optimization code
!
CALL cgfam(n,x,f,g,d,gold,iprint,eps,w,iflag,irest,method,finish&
     &,mpi_comm,mpi_size)
!
!       IFLAG=
!              0 : successful termination
!              1 : return to evaluate F and G
!              2 : return with a new iterate, try termination test
!             -i : error
!
IF(iflag.LE.0.OR.icall.GT.10000) go to 50
IF(iflag.EQ.1) THEN
   icall=icall + 1
   go to 20
ENDIF
IF(iflag.EQ.2) THEN
!
! Termination Test.  The user may replace it by some other test. However, 
! the parameter 'FINISH' must be set to 'TRUE' when the test is satisfied.
!
   tlev= eps*(one + dabs(f))
   i=0
40 i=i+1
   IF(i.GT.n) THEN
      finish = .true.
      go to 30
   ENDIF
   IF(dabs(g(i)).GT.tlev) THEN
      go to 30
   ELSE
      go to 40
   ENDIF
   
ENDIF
        
50 continue
        
!
! Code has terminated; print final results
!
if (iprint(1).ge.0.and.iflag.ge.0) then
   write (*,890) f
end if
return
!
! Formatting
!

820 format (//, ' Conjugate Gradient Minimization Routine', /)
840 format (/, ' n    =', i6, /,' method   =', i6,/,' irest    =', i6,/)
850 format (/,'  Error: negative N value'/)
890 format (/,' f(x*) =', 1pd16.8)


end subroutine subroutine_cg