Line data    Source code

       1           0 :       subroutine pda_fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa)
       2             :       integer m,n,ldfjac,iflag
       3             :       double precision epsfcn
       4             :       double precision x(n),fvec(m),fjac(ldfjac,n),wa(m)
       5             : c     **********
       6             : c
       7             : c     subroutine pda_fdjac2
       8             : c
       9             : c     this subroutine computes a forward-difference approximation
      10             : c     to the m by n jacobian matrix associated with a specified
      11             : c     problem of m functions in n variables.
      12             : c
      13             : c     the subroutine statement is
      14             : c
      15             : c       subroutine pda_fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa)
      16             : c
      17             : c     where
      18             : c
      19             : c       fcn is the name of the user-supplied subroutine which
      20             : c         calculates the functions. fcn must be declared
      21             : c         in an external statement in the user calling
      22             : c         program, and should be written as follows.
      23             : c
      24             : c         subroutine fcn(m,n,x,fvec,iflag)
      25             : c         integer m,n,iflag
      26             : c         double precision x(n),fvec(m)
      27             : c         ----------
      28             : c         calculate the functions at x and
      29             : c         return this vector in fvec.
      30             : c         ----------
      31             : c         return
      32             : c         end
      33             : c
      34             : c         the value of iflag should not be changed by fcn unless
      35             : c         the user wants to terminate execution of pda_fdjac2.
      36             : c         in this case set iflag to a negative integer.
      37             : c
      38             : c       m is a positive integer input variable set to the number
      39             : c         of functions.
      40             : c
      41             : c       n is a positive integer input variable set to the number
      42             : c         of variables. n must not exceed m.
      43             : c
      44             : c       x is an input array of length n.
      45             : c
      46             : c       fvec is an input array of length m which must contain the
      47             : c         functions evaluated at x.
      48             : c
      49             : c       fjac is an output m by n array which contains the
      50             : c         approximation to the jacobian matrix evaluated at x.
      51             : c
      52             : c       ldfjac is a positive integer input variable not less than m
      53             : c         which specifies the leading dimension of the array fjac.
      54             : c
      55             : c       iflag is an integer variable which can be used to terminate
      56             : c         the execution of pda_fdjac2. see description of fcn.
      57             : c
      58             : c       epsfcn is an input variable used in determining a suitable
      59             : c         step length for the forward-difference approximation. this
      60             : c         approximation assumes that the relative errors in the
      61             : c         functions are of the order of epsfcn. if epsfcn is less
      62             : c         than the machine precision, it is assumed that the relative
      63             : c         errors in the functions are of the order of the machine
      64             : c         precision.
      65             : c
      66             : c       wa is a work array of length m.
      67             : c
      68             : c     subprograms called
      69             : c
      70             : c       user-supplied ...... fcn
      71             : c
      72             : c       minpack-supplied ... pda_dpmpar
      73             : c
      74             : c       fortran-supplied ... dabs,dmax1,dsqrt
      75             : c
      76             : c     argonne national laboratory. minpack project. march 1980.
      77             : c     burton s. garbow, kenneth e. hillstrom, jorge j. more
      78             : c
      79             : c     **********
      80             :       integer i,j
      81             :       double precision eps,epsmch,h,temp,zero
      82             :       double precision pda_dpmpar
      83             :       data zero /0.0d0/
      84             : c
      85             : c     epsmch is the machine precision.
      86             : c
      87           0 :       epsmch = pda_dpmpar(1)
      88             : c
      89           0 :       eps = dsqrt(dmax1(epsfcn,epsmch))
      90           0 :       do 20 j = 1, n
      91           0 :          temp = x(j)
      92           0 :          h = eps*dabs(temp)
      93           0 :          if (h .eq. zero) h = eps
      94           0 :          x(j) = temp + h
      95           0 :          call fcn(m,n,x,wa,iflag)
      96           0 :          if (iflag .lt. 0) go to 30
      97           0 :          x(j) = temp
      98           0 :          do 10 i = 1, m
      99           0 :             fjac(i,j) = (wa(i) - fvec(i))/h
     100           0 :    10       continue
     101           0 :    20    continue
     102             :    30 continue
     103           0 :       return
     104             : c
     105             : c     last card of subroutine pda_fdjac2.
     106             : c
     107             :       end