mirror of https://gitlab.com/QEF/q-e.git
109 lines
3.3 KiB
Fortran
109 lines
3.3 KiB
Fortran
subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa)
|
|
integer m,n,ldfjac,iflag
|
|
double precision epsfcn
|
|
double precision x(n),fvec(m),fjac(ldfjac,n),wa(m)
|
|
! **********
|
|
!
|
|
! subroutine fdjac2
|
|
!
|
|
! this subroutine computes a forward-difference approximation
|
|
! to the m by n jacobian matrix associated with a specified
|
|
! problem of m functions in n variables.
|
|
!
|
|
! the subroutine statement is
|
|
!
|
|
! subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa)
|
|
!
|
|
! where
|
|
!
|
|
! fcn is the name of the user-supplied subroutine which
|
|
! calculates the functions. fcn must be declared
|
|
! in an external statement in the user calling
|
|
! program, and should be written as follows.
|
|
!
|
|
! subroutine fcn(m,n,x,fvec,iflag)
|
|
! integer m,n,iflag
|
|
! double precision x(n),fvec(m)
|
|
! ----------
|
|
! calculate the functions at x and
|
|
! return this vector in fvec.
|
|
! ----------
|
|
! return
|
|
! end
|
|
!
|
|
! the value of iflag should not be changed by fcn unless
|
|
! the user wants to terminate execution of fdjac2.
|
|
! in this case set iflag to a negative integer.
|
|
!
|
|
! m is a positive integer input variable set to the number
|
|
! of functions.
|
|
!
|
|
! n is a positive integer input variable set to the number
|
|
! of variables. n must not exceed m.
|
|
!
|
|
! x is an input array of length n.
|
|
!
|
|
! fvec is an input array of length m which must contain the
|
|
! functions evaluated at x.
|
|
!
|
|
! fjac is an output m by n array which contains the
|
|
! approximation to the jacobian matrix evaluated at x.
|
|
!
|
|
! ldfjac is a positive integer input variable not less than m
|
|
! which specifies the leading dimension of the array fjac.
|
|
!
|
|
! iflag is an integer variable which can be used to terminate
|
|
! the execution of fdjac2. see description of fcn.
|
|
!
|
|
! epsfcn is an input variable used in determining a suitable
|
|
! step length for the forward-difference approximation. this
|
|
! approximation assumes that the relative errors in the
|
|
! functions are of the order of epsfcn. if epsfcn is less
|
|
! than the machine precision, it is assumed that the relative
|
|
! errors in the functions are of the order of the machine
|
|
! precision.
|
|
!
|
|
! wa is a work array of length m.
|
|
!
|
|
! subprograms called
|
|
!
|
|
! user-supplied ...... fcn
|
|
!
|
|
! minpack-supplied ... dpmpar
|
|
!
|
|
! fortran-supplied ... dabs,dmax1,dsqrt
|
|
!
|
|
! argonne national laboratory. minpack project. march 1980.
|
|
! burton s. garbow, kenneth e. hillstrom, jorge j. more
|
|
!
|
|
! **********
|
|
integer i,j
|
|
double precision eps,epsmch,h,temp,zero
|
|
double precision dpmpar
|
|
data zero /0.0d0/
|
|
!
|
|
! epsmch is the machine precision.
|
|
!
|
|
epsmch = dpmpar(1)
|
|
!
|
|
eps = dsqrt(dmax1(epsfcn,epsmch))
|
|
do 20 j = 1, n
|
|
temp = x(j)
|
|
h = eps*dabs(temp)
|
|
if (h .eq. zero) h = eps
|
|
x(j) = temp + h
|
|
! write(*,*) 'ACCA', h,eps,temp, epsfcn
|
|
call fcn(m,n,x,wa,iflag)
|
|
if (iflag .lt. 0) go to 30
|
|
x(j) = temp
|
|
do 10 i = 1, m
|
|
fjac(i,j) = (wa(i) - fvec(i))/h
|
|
10 continue
|
|
20 continue
|
|
30 continue
|
|
return
|
|
!
|
|
! last card of subroutine fdjac2.
|
|
!
|
|
end
|