access_workspace Subroutine

   pure subroutine access_workspace &
      (n, m, np, q, ldwe, ld2we, &
       rwork, lrwork, iwork, liwork, &
       access, isodr, &
       jpvt, omega, u, qraux, sd, vcv, wrk1, wrk2, wrk3, wrk4, wrk5, wrk6, &
       nnzw, npp, &
       job, partol, sstol, maxit, taufac, eta, neta, &
       lunrpt, ipr1, ipr2, ipr2f, ipr3, &
       wss, rvar, idf, &
       tau, alpha, niter, nfev, njev, int2, olmavg, &
       rcond, irank, actrs, pnorm, prers, rnorms, istop)
   !! Access or store values in the work arrays.

      integer, intent(in) :: n
         !! Number of observations.
      integer, intent(in) :: m
         !! Number of columns of data in the explanatory variable.
      integer, intent(in) :: np
         !! Number of function parameters.
      integer, intent(in) :: q
         !! Number of responses per observation.
      integer, intent(in) :: ldwe
         !! Leading dimension of array `we`.
      integer, intent(in) :: ld2we
         !! Second dimension of array `we`.
      real(wp), intent(inout) :: rwork(lrwork)
         !! Real work space.
      integer, intent(in) :: lrwork
         !! Length of vector `rwork`.
      integer, intent(inout) :: iwork(liwork)
         !! Integer work space.
      integer, intent(in) :: liwork
         !! Length of vector `iwork`.
      logical, intent(in) :: access
         !! Variable designating whether information is to be accessed from the work
         !! arrays (`.true.`) or stored in them (`.false.`).
      logical, intent(in) :: isodr
         !! Variable designating whether the solution is to be found by ODR (`.true.`)
         !! or by OLS (`.false.`).
      integer, intent(out) :: jpvt
         !! Pivot vector.
      integer, intent(out) :: omega
         !! Starting location in array `rwork` of array `omega(q**2)`.
      integer, intent(out) :: u
         !! Starting location in array `rwork` of array `u(np)`.
      integer, intent(out) :: qraux
         !! Starting location in array `rwork` of array `qraux(np)`.
      integer, intent(out) :: sd
         !! Starting location in array `rwork` of array `sd(np)`.
      integer, intent(out) :: vcv
         !! Starting location in array `rwork` of array `vcv(np**2)`.
      integer, intent(out) :: wrk1
         !! Starting location in array `rwork` of array `wrk1(n, m, q)`.
      integer, intent(out) :: wrk2
         !! Starting location in array `rwork` of array `wrk2(n, q)`.
      integer, intent(out) :: wrk3
         !! Starting location in array `rwork` of array `wrk3(np)`.
      integer, intent(out) :: wrk4
         !! Starting location in array `rwork` of array `wrk4(m, m)`.
      integer, intent(out) :: wrk5
         !! Starting location in array `rwork` of array `wrk5(m)`.
      integer, intent(out) :: wrk6
         !! Starting location in array `rwork` of array `wrk6(n, np, q)`.
      integer, intent(out) :: nnzw
         !! Number of nonzero weighted observations.
      integer, intent(out) :: npp
         !! Number of function parameters actually estimated.
      integer, intent(out) :: job
         !! Variable controlling problem initialization and computational method.
      real(wp), intent(inout) :: partol
         !! Parameter convergence stopping tolerance.
      real(wp), intent(inout) :: sstol
         !! Sum-of-squares convergence stopping tolerance.
      integer, intent(out) :: maxit
         !! Maximum number of iterations allowed.
      real(wp), intent(out) :: taufac
         !! Factor used to compute the initial trust region diameter.
      real(wp), intent(out) :: eta
         !! Relative noise in the function results.
      integer, intent(out) :: neta
         !! Number of accurate digits in the function results.
      integer, intent(out) :: lunrpt
          !! Logical unit number used for computation reports.
      integer, intent(out) :: ipr1
         !! Value of the fourth digit (from the right) of `iprint`, which controls the
         !! initial summary report.
      integer, intent(out) :: ipr2
         !! Value of the third digit (from the right) of `iprint`, which controls the
         !! iteration reports.
      integer, intent(out) :: ipr2f
         !! Value of the second digit (from the right) of `iprint`, which controls the
         !! frequency of the iteration reports.
      integer, intent(out) :: ipr3
         !! Value of the first digit (from the right) of `iprint`, which controls the final
         !! summary report.
      real(wp), intent(inout) :: wss(3)
         !! Sum of the squares of the weighted `epsilons` and `deltas`, the sum of the squares
         !! of the weighted `deltas`, and the sum of the squares of the weighted `epsilons`.
      real(wp), intent(inout) :: rvar
         !! Residual variance, i.e. the standard deviation squared.
      integer, intent(inout) :: idf
         !! Degrees of freedom of the fit, equal to the number of observations with nonzero
         !! weighted derivatives minus the number of parameters being estimated.
      real(wp), intent(inout) :: tau
         !! Trust region diameter.
      real(wp), intent(inout) :: alpha
         !! Levenberg-Marquardt parameter.
      integer, intent(inout) :: niter
         !! Number of iterations taken.
      integer, intent(inout) :: nfev
         !! Number of function evaluations.
      integer, intent(inout) :: njev
         !! Number of Jacobian evaluations.
      integer, intent(inout) :: int2
         !! Number of internal doubling steps.
      real(wp), intent(inout) :: olmavg
         !! Average number of Levenberg-Marquardt steps per iteration.
      real(wp), intent(inout) :: rcond
         !! Approximate reciprocal condition of `fjacb`.
      integer, intent(inout) :: irank
         !! Rank deficiency of the Jacobian wrt `beta`.
      real(wp), intent(inout) :: actrs
         !! Saved actual relative reduction in the sum-of-squares.
      real(wp), intent(inout) :: pnorm
         !! Norm of the scaled estimated parameters.
      real(wp), intent(inout) :: prers
         !! Saved predicted relative reduction in the sum-of-squares.
      real(wp), intent(inout) :: rnorms
         !! Norm of the saved weighted `epsilons` and `deltas`.
      integer, intent(inout) :: istop
         !! Variable designating whether there are problems computing the function at the
         !! current `beta` and `delta`.

      ! Local scalars
      integer :: actrsi, alphai, betaci, betani, betasi, beta0i, boundi, deltai, deltani, &
                 deltasi, diffi, epsi, epsmaci, etai, fjacbi, fjacdi, fni, fsi, idfi, int2i, &
                 iprinti, iprint, iranki, istopi, jobi, jpvti, ldtti, liwkmin, loweri, lunerri, &
                 lunrpti, lrwkmin, maxiti, msgb, msgd, netai, nfevi, niteri, njevi, nnzwi, nppi, &
                 nrowi, ntoli, olmavgi, omegai, partoli, pnormi, prersi, qrauxi, rcondi, rnormsi, &
                 rvari, sdi, si, ssfi, ssi, sstoli, taufaci, taui, ti, tti, ui, upperi, vcvi, &
                 we1i, wrk1i, wrk2i, wrk3i, wrk4i, wrk5i, wrk6i, wrk7i, wssi, wssdeli, wssepsi, &
                 xplusdi

      ! Variable Definitions (alphabetically)
      !  ACTRSI:  The location in array RWORK of variable ACTRS.
      !  ALPHAI:  The location in array RWORK of variable ALPHA.
      !  BETACI:  The starting location in array RWORK of array BETAC.
      !  BETANI:  The starting location in array RWORK of array BETAN.
      !  BETASI:  The starting location in array RWORK of array BETAS.
      !  BETA0I:  The starting location in array RWORK of array BETA0.
      !  DELTAI:  The starting location in array RWORK of array DELTA.
      !  DELTANI: The starting location in array RWORK of array DELTAN.
      !  DELTASI: The starting location in array RWORK of array DELTAS.
      !  DIFFI:   The starting location in array RWORK of array DIFF.
      !  EPSI:    The starting location in array RWORK of array EPS.
      !  EPSMACI: The location in array RWORK of variable EPSMAC.
      !  ETAI:    The location in array RWORK of variable ETA.
      !  FJACBI:  The starting location in array RWORK of array FJACB.
      !  FJACDI:  The starting location in array RWORK of array FJACD.
      !  FNI:     The starting location in array RWORK of array FN.
      !  FSI:     The starting location in array RWORK of array FS.
      !  IDFI:    The starting location in array IWORK of variable IDF.
      !  INT2I:   The location in array IWORK of variable INT2.
      !  IPRINTI: The location in array IWORK of variable IPRINT.
      !  IPRINT:  The print control variable.
      !  IRANKI:  The location in array IWORK of variable IRANK.
      !  ISTOPI:  The location in array IWORK of variable ISTOP.
      !  JOBI:    The location in array IWORK of variable JOB.
      !  JPVTI:   The starting location in array IWORK of variable JPVT.
      !  LDTTI:   The starting location in array IWORK of variable LDTT.
      !  LUNERRI: The location in array IWORK of variable LUNERR.
      !  LUNRPTI: The location in array IWORK of variable LUNRPT.
      !  LRWKMIN: The minimum acceptable length of array RWORK.
      !  MAXITI:  The location in array IWORK of variable MAXIT.
      !  MSGB:    The starting location in array IWORK of array MSGB.
      !  MSGD:    The starting location in array IWORK of array MSGD.
      !  NETAI:   The location in array IWORK of variable NETA.
      !  NFEVI:   The location in array IWORK of variable NFEV.
      !  NITERI:  The location in array IWORK of variable NITER.
      !  NJEVI:   The location in array IWORK of variable NJEV.
      !  NNZWI:   The location in array IWORK of variable NNZW.
      !  NPPI:    The location in array IWORK of variable NPP.
      !  NROWI:   The location in array IWORK of variable NROW.
      !  NTOLI:   The location in array IWORK of variable NTOL.
      !  OLMAVGI: The location in array RWORK of variable OLMAVG.
      !  OMEGAI:  The starting location in array RWORK of array OMEGA.
      !  PARTOLI: The location in array work of variable PARTOL.
      !  PNORMI:  The location in array RWORK of variable PNORM.
      !  PRERSI:  The location in array RWORK of variable PRERS.
      !  QRAUXI:  The starting location in array RWORK of array QRAUX.
      !  RCONDI:  The location in array RWORK of variable RCOND.
      !  RNORMSI: The location in array RWORK of variable RNORMS.
      !  RVARI:   The location in array RWORK of variable RVAR.
      !  SDI:     The starting location in array RWORK of array SD.
      !  SSFI:    The starting location in array RWORK of array SSF.
      !  SSI:     The starting location in array RWORK of array SS.
      !  SSTOLI:  The location in array RWORK of variable SSTOL.
      !  TAUFACI: The location in array RWORK of variable TAUFAC.
      !  TAUI:    the location in array RWORK of variable TAU.
      !  TI:      The starting location in array RWORK of array T.
      !  TTI:     The starting location in array RWORK of array TT.
      !  UI:      The starting location in array RWORK of array U.
      !  VCVI:    The starting location in array RWORK of array VCV.
      !  WE1I:    The starting location in array RWORK of array WE1.
      !  WRK1I:   The starting location in array RWORK of array WRK1.
      !  WRK2I:   The starting location in array RWORK of array WRK2.
      !  WRK3I:   The starting location in array RWORK of array wrk3.
      !  WRK4I:   The starting location in array RWORK of array wrk4.
      !  WRK5I:   The starting location in array RWORK of array wrk5.
      !  WRK6I:   The starting location in array RWORK of array wrk6.
      !  WRK7I:   The starting location in array RWORK of array wrk7.
      !  WSSI:    The starting location in array RWORK of variable WSS(1).
      !  WSSDELI: The starting location in array RWORK of variable WSS(2).
      !  WSSEPSI: The starting location in array RWORK of variable WSS(3).
      !  XPLUSDI: The starting location in array RWORK of array XPLUSD.

      ! Find starting locations within integer workspace
      call loc_iwork(m, q, np, &
                     msgb, msgd, jpvti, istopi, &
                     nnzwi, nppi, idfi, &
                     jobi, iprinti, lunerri, lunrpti, &
                     nrowi, ntoli, netai, &
                     maxiti, niteri, nfevi, njevi, int2i, iranki, ldtti, &
                     boundi, &
                     liwkmin)

      ! Find starting locations within REAL work space
      call loc_rwork(n, m, q, np, ldwe, ld2we, isodr, &
                     deltai, epsi, xplusdi, fni, sdi, vcvi, &
                     rvari, wssi, wssdeli, wssepsi, rcondi, etai, &
                     olmavgi, taui, alphai, actrsi, pnormi, rnormsi, prersi, &
                     partoli, sstoli, taufaci, epsmaci, &
                     beta0i, betaci, betasi, betani, si, ssi, ssfi, qrauxi, ui, &
                     fsi, fjacbi, we1i, diffi, &
                     deltasi, deltani, ti, tti, omegai, fjacdi, &
                     wrk1i, wrk2i, wrk3i, wrk4i, wrk5i, wrk6i, wrk7i, &
                     loweri, upperi, &
                     lrwkmin)

      if (access) then
         ! Set starting locations for work vectors
         jpvt = jpvti
         omega = omegai
         qraux = qrauxi
         sd = sdi
         vcv = vcvi
         u = ui
         wrk1 = wrk1i
         wrk2 = wrk2i
         wrk3 = wrk3i
         wrk4 = wrk4i
         wrk5 = wrk5i
         wrk6 = wrk6i

         ! Access values from the work vectors
         actrs = rwork(actrsi)
         alpha = rwork(alphai)
         eta = rwork(etai)
         olmavg = rwork(olmavgi)
         partol = rwork(partoli)
         pnorm = rwork(pnormi)
         prers = rwork(prersi)
         rcond = rwork(rcondi)
         wss(1) = rwork(wssi)
         wss(2) = rwork(wssdeli)
         wss(3) = rwork(wssepsi)
         rvar = rwork(rvari)
         rnorms = rwork(rnormsi)
         sstol = rwork(sstoli)
         tau = rwork(taui)
         taufac = rwork(taufaci)

         neta = iwork(netai)
         irank = iwork(iranki)
         job = iwork(jobi)
         lunrpt = iwork(lunrpti)
         maxit = iwork(maxiti)
         nfev = iwork(nfevi)
         niter = iwork(niteri)
         njev = iwork(njevi)
         nnzw = iwork(nnzwi)
         npp = iwork(nppi)
         idf = iwork(idfi)
         int2 = iwork(int2i)

         ! Set up print control variables
         iprint = iwork(iprinti)
         ipr1 = mod(iprint, 10000)/1000
         ipr2 = mod(iprint, 1000)/100
         ipr2f = mod(iprint, 100)/10
         ipr3 = mod(iprint, 10)

      else
         ! Store values into the work vectors
         rwork(actrsi) = actrs
         rwork(alphai) = alpha
         rwork(olmavgi) = olmavg
         rwork(partoli) = partol
         rwork(pnormi) = pnorm
         rwork(prersi) = prers
         rwork(rcondi) = rcond
         rwork(wssi) = wss(1)
         rwork(wssdeli) = wss(2)
         rwork(wssepsi) = wss(3)
         rwork(rvari) = rvar
         rwork(rnormsi) = rnorms
         rwork(sstoli) = sstol
         rwork(taui) = tau

         iwork(iranki) = irank
         iwork(istopi) = istop
         iwork(nfevi) = nfev
         iwork(niteri) = niter
         iwork(njevi) = njev
         iwork(idfi) = idf
         iwork(int2i) = int2
      end if

   end subroutine access_workspace