module calc_energ_m
  use constants_m
  implicit none

contains
  ! calculate energy of a slice on sa
  function energ_sa(j_couple, spin, k, m, n)
    implicit none
    real(DR), dimension(n,n,n,n), intent(in) :: j_couple
    integer(SI), dimension(n,n,m) :: spin
    integer(SI) :: ix, iy, jx, jy
    integer(SI), intent(in) :: k, m, n
    real(DR) :: energ_sa

    energ_sa = 0.0d0

    do jy = 1, n
      do jx = 1, n
        do iy = 1, n
          do ix = 1, n
            energ_sa = energ_sa - 1/2.0 * j_couple(ix ,iy ,jx, jy) &
            * spin(ix, iy, k) * spin(jx, jy, k)
          end do
        end do
      end do
    end do

  end function energ_sa

  ! calculate average of energy of all replica in qa
  function energ_qa(j_couple, spin, j_tilda, m, n)
    implicit none
    real(DR), dimension(n,n,n,n), intent(in) :: j_couple
    real(DR), intent(in) :: j_tilda
    real(DR), dimension(:), allocatable :: energ_0, energ_1
    integer(SI), dimension(n,n,m), intent(in) :: spin
    integer(SI), intent(in) :: m, n
    integer(SI) :: ix, iy, jx, jy, k, tmp
    real(DR) :: energ_qa

    allocate(energ_0(m))
    allocate(energ_1(m))

    energ_0 = 0.0d0
    energ_1 = 0.0d0

    do k = 1, m
      do jy = 1, n
        do jx = 1, n
          do iy = 1, n
            do ix = 1, n
              energ_0(k) = energ_0(k) - (1/2.0) * j_couple(ix, iy, jx, jy) &
              * spin(ix, iy, k) * spin(jx, jy, k)
            end do
          end do
        end do
      end do
    end do

    do k = 1, m - 1
      do iy = 1, n
        do ix = 1, n
          energ_1(k) = energ_1(k) - spin(ix, iy, k) * spin(ix, iy, k + 1)
        end do
      end do
    end do

    !k = m
    do iy = 1, n
      do ix = 1, n
        energ_1(m) = energ_1(m) - spin(ix, iy, m) * spin(ix ,iy, 1)
      end do
    end do

    energ_qa = sum(energ_0) / m + j_tilda * sum(energ_1)
  end function energ_qa

  function delta_qa(j_couple, spin_new, j_tilda, site_x, site_y, k, m, n)
    implicit none
    real(DR), intent(in) ::  j_tilda
    real(DR), dimension(n,n,n,n), intent(in) :: j_couple
    integer(SI), dimension(n,n,m), intent(in) :: spin_new
    integer(SI), intent(in) :: site_x, site_y, k, m, n
    integer(SI) :: x, y
    real(DR) :: delta_energ_0, delta_energ_1
    real(DR) :: delta_qa

    delta_energ_0 = 0.0d0
    delta_energ_1 = 0.0d0

    !一項目
    do y = 1, n
      do x = 1, n
        delta_energ_0 = delta_energ_0 - (1/2.0) * &
        j_couple(x, y, site_x, site_y) * spin_new(x, y, k) * spin_new(site_x, site_y, k)

        delta_energ_0 = delta_energ_0 - (1/2.0) * &
        j_couple(site_x, site_y, x, y) * spin_new(x, y, k) * spin_new(site_x, site_y, k)
      end do
    end do

    !二項目
    if(k == m) then
      delta_energ_1 = delta_energ_1 - spin_new(site_x, site_y, m-1) * &
      spin_new(site_x, site_y, m)
      delta_energ_1 = delta_energ_1 - spin_new(site_x, site_y, m) * &
      spin_new(site_x, site_y, 1)
    else if(k == 1) then
      delta_energ_1 = delta_energ_1 - spin_new(site_x, site_y, m) * &
      spin_new(site_x, site_y, 1)
      delta_energ_1 = delta_energ_1 - spin_new(site_x, site_y, 1) * &
      spin_new(site_x, site_y, 2)
    else
      delta_energ_1 = delta_energ_1 - spin_new(site_x, site_y, k - 1) * &
      spin_new(site_x, site_y, k)
      delta_energ_1 = delta_energ_1 - spin_new(site_x, site_y, k) * &
      spin_new(site_x, site_y, k + 1)
    end if

    delta_qa = 2 * ((delta_energ_0 / m) + (j_tilda * delta_energ_1))

  end function delta_qa

  !横磁場項の計算
  function TMF_term(spin, j_tilda, m, n)
    real(DR), intent(in) ::  j_tilda
    integer(SI), dimension(n,n,m), intent(in) :: spin
    integer(SI), intent(in) :: m, n
    integer(SI) :: ix, iy, k
    real(DR), dimension(:), allocatable :: energ_1
    real(DR) :: TMF_term

    allocate(energ_1(m))

    energ_1 = 0.0d0

    do k = 1, m - 1
      do iy = 1, n
        do ix = 1, n
          energ_1(k) = energ_1(k) - spin(ix, iy, k) * spin(ix, iy, k + 1)
        end do
      end do
    end do

    !k = m
    do iy = 1, n
      do ix = 1, n
        energ_1(m) = energ_1(m) - spin(ix, iy, m) * spin(ix ,iy, 1)
      end do
    end do

    TMF_term = j_tilda * sum(energ_1)

  end function TMF_term
end module calc_energ_m


c-----------------------------------------------------------------------
      program test

      include 'ceedf.h'

      integer ceed,err
      integer b
      real*8 colograd1d(16), colograd1d2(36)

      character arg*32

      call getarg(1,arg)

      call ceedinit(trim(arg)//char(0),ceed,err)

c     Already collocated, GetCollocatedGrad will return grad1d
      call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,
     $  ceed_gauss_lobatto,b,err)
      call ceedbasisgetcollocatedgrad(b,colograd1d,err)
      call ceedbasisview(b,err)
      do i=1,16
        if (abs(colograd1d(i))<1.0D-14) then
          colograd1d(i) = 0
        endif
      enddo
      do i=0,3
        write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')
     $ 'colograd[',i,']:',(colograd1d(j+4*i),j=1,4)
      call flush(6)
      enddo
      call ceedbasisdestroy(b,err)

c     Q = P, not already collocated
      call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,
     $  ceed_gauss,b,err)
      call ceedbasisgetcollocatedgrad(b,colograd1d,err)
      call ceedbasisview(b,err)
      do i=1,16
        if (abs(colograd1d(i))<1.0D-14) then
          colograd1d(i) = 0
        endif
      enddo
      do i=0,3
        write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')
     $ 'colograd[',i,']:',(colograd1d(j+4*i),j=1,4)
      call flush(6)
      enddo
      call ceedbasisdestroy(b,err)

c     Q = P + 2, not already collocated
      call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,6,
     $  ceed_gauss,b,err)
      call ceedbasisgetcollocatedgrad(b,colograd1d2,err)
      call ceedbasisview(b,err)
      do i=1,36
        if (abs(colograd1d2(i))<1.0D-14) then
          colograd1d2(i) = 0
        endif
      enddo
      do i=0,5
        write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')
     $ 'colograd[',i,']:',(colograd1d2(j+6*i),j=1,6)
      call flush(6)
      enddo
      call ceedbasisdestroy(b,err)

      call ceeddestroy(ceed,err)

      end
c-----------------------------------------------------------------------


      subroutine RKPMshape2d(shp,b,bd,cpt,cjt,haj,wjt)
!
!**************************************************************
!
!     This subroutine is to calculate the shape functions and
!     their derivatives for the moving least square method
!     ---- reproducing kernel method.
!     This code is only offering shape functions and its' 1st
!     order derivatives for 2-D case.
!
!     That is :  N_{jt}(xpt,ypt)
!     jt: the integer index for shape function, i.e.
!         we are computing N_{jt}; 1<jt<nep
!
!     Date: June, 1994
!
!     -arguments:
!
!  i      cjt(2):  the jt th particle's global coordinations;
!                  (jt is the integer index for shape function)
!                  i.e.  N_{jt},  1 < jt < nep
!
!                      such as x(jt):= cjt(1)
!                              y(jt):= cjt(2)
!
!
!  i      cpt(2): the point at where the shape function is
!                     evaluated.;
!                 x(pt):= cpt(1)
!                 y(pt):= cpt(2)
!
!
!  i      haj(2): the radius of particle's compact support.
!                 the radius at X direction: haj(1)
!                 the radius at Y direction: haj(2)
!
!
!  i      wjt: integration weight at particle jt;
!
!
!     o   coref: correct function at pt. cpt and particle cjt
!         C(cjt, cpt);
!
!
!     o   shp: shape functions and their 1st derivative
!                       at point cpt;
!
!     o   shp(0)    : shape function N_{jt} at cpt ;
!
!     o   shp(1): the X-derivative of shape function
!                          N_{jt},x  at cpt;
!
!     o   shp(2): the Y-derivative of shape function
!                          N_{jt},y at cpt;
!
!
!     The subroutine is only designed for solving 2-D locally
!     linear interpolation moving field problem. i.e.
!
!    l   p0   := (1,0,0);
!
!    l   p(3) := (1,x,y);
!
!    There two different subroutines are called by this subroutine:
!
!    window2dr.f ----- the cartesian product type window function;
!
!    window2dc.f ----- the circular disc type window function
!
!**************************************************************
      implicit none
!
      real*8 cpt(2),shpd(2)
      real*8 cjt(2),p(3),pdx(3),pdy(3)
      real*8 b(*),bd(2,*),haj(2)
      real*8 coref,cdx,cdy,ha1,ha2,xx,yy,xj,yj,xp,yp,shp,wjt
      real*8 aw,awdx,awdy,awdxx,awdxy,awdyy
      integer i
!
!.....find the polynominal p
      xp = cpt(1)
      yp = cpt(2)
      xj = cjt(1)
      yj = cjt(2)
!
!.....assign value to working array
      ha1    = haj(1)
      ha2    = haj(2)
      p(1)   = 1.0d0
      p(2)   = (xj - xp)/ha1
      p(3)   = (yj - yp)/ha2
      pdx(1) =   0.0d0
      pdx(2) = - 1.0d0/ha1
      pdx(3) =   0.0d0
      pdy(1) =   0.0d0
      pdy(2) =   0.0d0
      pdy(3) = - 1.0d0/ha2

!.....compute correct function  C
      coref = 0.0d0
      do i = 1,3
		coref = coref + p(i)*b(i)
      enddo
!
      cdx = 0.0d0
      cdy = 0.0d0
      do i = 1,3
		 cdx = cdx + pdx(i)*b(i) + p(i)*bd(1,i)
		 cdy = cdy + pdy(i)*b(i) + p(i)*bd(2,i)
      enddo

!.....check whether or not the point is within the compact support
      xx = dabs(xj - xp)/ha1
      yy = dabs(yj - yp)/ha2

      if (xx .gt. 2.0 .or. yy .gt. 2.0) then
		  shp      = 0.00
		  shpd(1)  = 0.00
		  shpd(2)  = 0.00
      else
          call window(aw,awdx,awdy,awdxx,awdxy,awdyy,xp,yp,xj,yj,ha1,ha2)
!.....calculate the shape functions
          shp     = coref*aw*wjt
!.....calculate the 1st derivatives of the shape function
          shpd(1) = (cdx*aw+coref*awdx)*wjt
          shpd(2) = (cdy*aw+coref*awdy)*wjt
      end if
  999 continue
      return
      end

      subroutine window(aw,awdx,awdy,awdxx,awdxy,awdyy,xx,yy,xj,yj,a1,a2)
!***********************************************************
!
!   This is a subroutine to compute 2-D cubic spline window
!   function and its first and second derivatives.
!   In this subroutine, the window function is constructed by
!   Cartesian product.
!   The mathematical formulation of this code is based on:
!
!   ``Ten lectures on Wavelets'' by Ingrid Daubechies,
!     page 79.
!
!   arguments:
!
!   i         a1:  dilation parameter in X-direction;
!
!   i         a2:  dilation parameter in Y-direction;
!
!   Note: there is a difference between dilation parameter and
!         the dilation coefficient.
!
!      o      aw:  2-D cubic spline window function:
!
!   Note:     Phi_r := (1/rho) Phi(X/rho).
!
!      o    awdx:  d/dx(aw);
!
!      o    awdy:  d/dy(aw);
!
!      o   awdxx:  d^2/dx^2(aw);
!
!      o   awdyy:  d^2/dy^2(aw);
!
!      o   awdxy:  d^2/dxdy(aw);
!
!   i         xx:  X-coordinate for arbitary point;
!
!   i         yy:  Y-coordinate for arbitary point;
!
!   i         xj:  X-coordinate for particle j;
!
!   i         yj:  Y-coordinate for particle j;
!
!
!    Author: Shaofan Li
!
!    Date: October, 1996
!
!
!*************************************************************
      implicit double precision (a-h,o-z)
!
!.....Cartsian product window function
!
!.....normalize the argument
!
      x1  = (xj-xx)/a1
      x2  =  x1 * x1
      x3  =  x2 * x1
      y1  = (yj-yy)/a2
      y2  =  y1 * y1
      y3  =  y2 * y1
      two1 = -2.0d0
      one1 = -1.0d0
      zero =  0.0d0
      one2 =  1.0d0
      two2 =  2.0d0
!
!.....dfx := d(xr)/dx; dfy:= d(yr)/dy
      dx1  = -1.0d0/a1
      dx2  =  dx1 * dx1
      dy1  = -1.0d0/a2
      dy2  =  dy1 * dy1
      hv = 1.0d0/(a1*a2)
      if((x1.ge.two1).and.(x1.lt.one1)) then
        awx   = (1.0d0/6.0d0)*(2.0d0 + x1)**3.
        awxd  = dx1*0.5d0*(2.0d0 + x1)**2.0
        awxdd = dx2*(2.0d0 + x1)
      elseif ((x1.ge.one1).and.(x1.lt.zero)) then
        awx   =   2.0d0/3.0d0 - x2 - 0.50d0*x3
        awxd  = - dx1*(2.0d0*x1 + 1.50d0*x2)
        awxdd = - dx2*(2.0d0 + 3.0d0*x1)
      elseif ((x1.ge.zero).and.(x1.lt.one2)) then
        awx   =   2.0d0/3.0d0 - x2 + 0.50d0*x3
        awxd  = - dx1*(2.0d0*x1 - 1.50d0*x2)
        awxdd = - dx2*(2.0d0 - 3.0d0*x1 )
      elseif ((x1.ge.one2).and.(x1.le.two2)) then
        awx   =   (1.0d0/6.0d0)*(2.0d0 - x1)**3.
        awxd  = - dx1*0.5d0*(2.0d0 - x1)**2.0
        awxdd =   dx2*(2.0d0 - x1)
      else
        awx   = 0.00d0
        awxd  = 0.00d0
        awxdd = 0.00d0
      endif

      if((y1.ge.two1).and.(y1.lt.one1)) then
        awy   = (1.0d0/6.0d0)*(2.0d0 + y1)**3.0
        awyd  = dy1*0.5d0*(2.0d0 + y1 )**2.
        awydd = dy2*(2.0d0 + y1 )
      elseif ((y1.ge.one1).and.(y1.lt.zero)) then
        awy   =   2.0d0/3.0d0 - y2 - 0.5d0*y3
        awyd  = - dy1*(2.0d0*y1 + 1.5d0*y2)
        awydd = - dy2*(2.0d0 + 3.0d0*y1 )
      elseif ((y1.ge.zero).and.(y1.lt.one2)) then
        awy   =   2.0d0/3.0d0 - y2 + 0.5d0*y3
        awyd  = - dy1*(2.0d0*y1 - 1.5d0*y2)
        awydd = - dy2*(2.0d0 - 3.0d0*y1 )
      elseif ((y1.ge.one2).and.(y1.le.two2)) then
        awy   =   (1.0d0/6.0d0)*(2.0d0 - y1)**3.0
        awyd  = - dy1*0.5d0*(2.0d0 - y1)**2.0
        awydd =   dy2*(2.0d0 - y1)
      else
        awy   = 0.00d0
        awyd  = 0.00d0
        awydd = 0.00d0
      endif

      aw    = awx*awy*hv
      awdx  = awxd*awy*hv
      awdy  = awx*awyd*hv
      awdxy = awxd*awyd*hv
      awdxx = awxdd*awy*hv
      awdyy = awx*awydd*hv
      return
      end


!*==spotrf.f90  processed by SPAG 7.51RB at 21:02 on  3 Mar 2022
!> \brief \b SPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
!
!  =========== DOCUMENTATION ===========
!
! Online html documentation available at
!            http://www.netlib.org/lapack/explore-html/
!
!  Definition:
!  ===========
!
!       SUBROUTINE SPOTRF ( UPLO, N, A, LDA, INFO )
!
!       .. Scalar Arguments ..
!       CHARACTER          UPLO
!       INTEGER            INFO, LDA, N
!       ..
!       .. Array Arguments ..
!       REAL               A( LDA, * )
!       ..
!
!  Purpose
!  =======
!
!>\details \b Purpose:
!>\verbatim
!>
!> SPOTRF computes the Cholesky factorization of a real symmetric
!> positive definite matrix A.
!>
!> The factorization has the form
!>    A = U**T * U,  if UPLO = 'U', or
!>    A = L  * L**T,  if UPLO = 'L',
!> where U is an upper triangular matrix and L is lower triangular.
!>
!> This is the right looking block version of the algorithm, calling Level 3 BLAS.
!>
!>\endverbatim
!
!  Arguments:
!  ==========
!
!> \param[in] UPLO
!> \verbatim
!>          UPLO is CHARACTER*1
!>          = 'U':  Upper triangle of A is stored;
!>          = 'L':  Lower triangle of A is stored.
!> \endverbatim
!>
!> \param[in] N
!> \verbatim
!>          N is INTEGER
!>          The order of the matrix A.  N >= 0.
!> \endverbatim
!>
!> \param[in,out] A
!> \verbatim
!>          A is REAL array, dimension (LDA,N)
!>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
!>          N-by-N upper triangular part of A contains the upper
!>          triangular part of the matrix A, and the strictly lower
!>          triangular part of A is not referenced.  If UPLO = 'L', the
!>          leading N-by-N lower triangular part of A contains the lower
!>          triangular part of the matrix A, and the strictly upper
!>          triangular part of A is not referenced.
!> \endverbatim
!> \verbatim
!>          On exit, if INFO = 0, the factor U or L from the Cholesky
!>          factorization A = U**T*U or A = L*L**T.
!> \endverbatim
!>
!> \param[in] LDA
!> \verbatim
!>          LDA is INTEGER
!>          The leading dimension of the array A.  LDA >= max(1,N).
!> \endverbatim
!>
!> \param[out] INFO
!> \verbatim
!>          INFO is INTEGER
!>          = 0:  successful exit
!>          < 0:  if INFO = -i, the i-th argument had an illegal value
!>          > 0:  if INFO = i, the leading minor of order i is not
!>                positive definite, and the factorization could not be
!>                completed.
!> \endverbatim
!>
!
!  Authors:
!  ========
!
!> \author Univ. of Tennessee
!> \author Univ. of California Berkeley
!> \author Univ. of Colorado Denver
!> \author NAG Ltd.
!
!> \date December 2016
!
!> \ingroup variantsPOcomputational
!
!  =====================================================================
      SUBROUTINE SPOTRF(Uplo,N,A,Lda,Info)
      IMPLICIT NONE
!*--SPOTRF104
!
!  -- LAPACK computational routine (version 3.1) --
!  -- LAPACK is a software package provided by Univ. of Tennessee,    --
!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
!     December 2016
!
!     .. Scalar Arguments ..
      CHARACTER Uplo
      INTEGER Info , Lda , N
!     ..
!     .. Array Arguments ..
      REAL A(Lda,*)
!     ..
!
!  =====================================================================
!
!     .. Parameters ..
      REAL ONE
      PARAMETER (ONE=1.0E+0)
!     ..
!     .. Local Scalars ..
      LOGICAL upper
      INTEGER j , jb , nb
!     ..
!     .. External Functions ..
      LOGICAL LSAME
      INTEGER ILAENV
      EXTERNAL LSAME , ILAENV
!     ..
!     .. External Subroutines ..
      EXTERNAL SGEMM , SPOTF2 , SSYRK , STRSM , XERBLA
!     ..
!     .. Intrinsic Functions ..
      INTRINSIC MAX , MIN
!     ..
!     .. Executable Statements ..
!
!     Test the input parameters.
!
      Info = 0
      upper = LSAME(Uplo,'U')
      IF ( .NOT.upper .AND. .NOT.LSAME(Uplo,'L') ) THEN
         Info = -1
      ELSEIF ( N<0 ) THEN
         Info = -2
      ELSEIF ( Lda<MAX(1,N) ) THEN
         Info = -4
      ENDIF
      IF ( Info/=0 ) THEN
         CALL XERBLA('SPOTRF',-Info)
         RETURN
      ENDIF
!
!     Quick return if possible
!
      IF ( N==0 ) RETURN
!
!     Determine the block size for this environment.
!
      nb = ILAENV(1,'SPOTRF',Uplo,N,-1,-1,-1)
      IF ( nb<=1 .OR. nb>=N ) THEN
!
!        Use unblocked code.
!
         CALL SPOTF2(Uplo,N,A,Lda,Info)
!
!        Use blocked code.
!
      ELSEIF ( upper ) THEN
!
!           Compute the Cholesky factorization A = U'*U.
!
         DO j = 1 , N , nb
!
!              Update and factorize the current diagonal block and test
!              for non-positive-definiteness.
!
            jb = MIN(nb,N-j+1)

            CALL SPOTF2('Upper',jb,A(j,j),Lda,Info)

            IF ( Info/=0 ) GOTO 100

            IF ( j+jb<=N ) THEN
!
!                 Updating the trailing submatrix.
!
               CALL STRSM('Left','Upper','Transpose','Non-unit',jb,     &
     &                    N-j-jb+1,ONE,A(j,j),Lda,A(j,j+jb),Lda)
               CALL SSYRK('Upper','Transpose',N-j-jb+1,jb,-ONE,A(j,j+jb)&
     &                    ,Lda,ONE,A(j+jb,j+jb),Lda)
            ENDIF
         ENDDO
!
      ELSE
!
!           Compute the Cholesky factorization A = L*L'.
!
         DO j = 1 , N , nb
!
!              Update and factorize the current diagonal block and test
!              for non-positive-definiteness.
!
            jb = MIN(nb,N-j+1)

            CALL SPOTF2('Lower',jb,A(j,j),Lda,Info)

            IF ( Info/=0 ) GOTO 100

            IF ( j+jb<=N ) THEN
!
!                Updating the trailing submatrix.
!
               CALL STRSM('Right','Lower','Transpose','Non-unit',       &
     &                    N-j-jb+1,jb,ONE,A(j,j),Lda,A(j+jb,j),Lda)

               CALL SSYRK('Lower','No Transpose',N-j-jb+1,jb,-ONE,      &
     &                    A(j+jb,j),Lda,ONE,A(j+jb,j+jb),Lda)
            ENDIF
         ENDDO
      ENDIF
      GOTO 99999
!
 100  Info = Info + j - 1
!
!
!     End of SPOTRF
!
99999 END SUBROUTINE SPOTRF


************************************************************************
*
*
*     LMBM includes the following subroutines
*
*     S   LMBMU         Initialization for limited memory bundle
*                         subroutine.
*     S   LMBM          Limited memory bundle subroutine for nonsmooth
*                         large-scale optimization.
*
*
************************************************************************
*
*     * SUBROUTINE LMBMU *
*
*
*     * Purpose *
*
*     Initialization for limited memory bundle subroutine for
*     large-scale unconstrained nonsmooth optimization.
*
*
*     * Calling sequence *
*
*     CALL LMBMU(N,NA,MCU,MC,NW,X,F,RPAR,IPAR,IOUT,TIME,RTIM,W)
*
*
*     * Parameters *
*
*     II  N             Number of variables.
*     II  NA            Maximum bundle dimension, NA >= 2.
*     IU  MC            Maximum number of stored corrections, MC >= 3.
*     II  MCU           Upper limit for maximum number of stored
*                         corrections, MCU >= MC.
*     RU  X(N)          Vector of variables.
*     RO  F             Value of the objective function.
*     RI  TIME          Maximum CPU-time in seconds. If TIME <= 0.0
*                         the maximum time is ignored. REAL argument.
*     RI  RTIM(2)       Auxiliary array. REAL array
*                         On output RTIM(1) contains the execution time.
*     RI  RPAR(8)       Real parameters:
*           RPAR(1)       Tolerance for change of function values.
*           RPAR(2)       Second Tolerance for change of function values.
*           RPAR(3)       Tolerance for the function value.
*           RPAR(4)       Tolerance for the first termination criterion.
*           RPAR(5)       Tolerance for the second termination criterion.
*           RPAR(6)       Distance measure parameter, 0 <= RPAR(6).
*           RPAR(7)       Line search parameter, 0 < RPAR(7) < 0.25.
*           RPAR(8)       Maximum stepsize, 1 < RPAR(8).
*                           If RPAR(I) <= 0 for I=1,3,4,5,7, and 8 the
*                           default value of the parameter will be used.
*                           If RPAR(2) < 0 the the parameter and the
*                           corresponding termination criterion will be
*                           ignored. If RPAR(2) = 0 default value will
*                           be used. If RPAR(6) < 0 the default value
*                           will be used.
*     II  IPAR(7)       Integer paremeters:
*           IPAR(1)       Exponent for distance measure.
*           IPAR(2)       Maximum number of iterations.
*           IPAR(3)       Maximum number of function evaluations.
*           IPAR(4)       Maximum number of iterations with changes of
*                           function values smaller than RPAR(1).
*           IPAR(5)       Printout specification:
*                             -1  - No printout.
*                              0  - Only the error messages.
*                              1  - The final values of the objective
*                                   function.
*                              2  - The final values of the objective
*                                   function and the most serious
*                                   warning messages.
*                              3  - The whole final solution.
*                              4  - At each iteration values of the
*                                   objective function.
*                              5  - At each iteration the whole
*                                   solution
*           IPAR(6)       Selection of the method:
*                              0  - Limited memory bundle method.
*                              1  - L-BFGS bundle method.
*           IPAR(7)       Selection of the scaling:
*                              0  - Scaling at every iteration with STU/UTU.
*                              1  - Scaling at every iteration with STS/STU.
*                              2  - Interval scaling with STU/UTU.
*                              3  - Interval scaling with STS/STU.
*                              4  - Preliminary scaling with STU/UTU.
*                              5  - Preliminary scaling with STS/STU.
*                              6  - No scaling.
*     IO  IOUT(3)       Integer parameters:
*           IOUT(1)       Number of used iterations.
*           IOUT(2)       Number of used function evaluations.
*           IOUT(3)       Cause of termination:
*                              1  - The problem has been solved.
*                                   with desired accuracy.
*                              2  - Changes in function values < RPAR(1)
*                                   in IPAR(4) subsequent iterations.
*                              3  - Changes in function values < RPAR(2)
*                                   *SMALL*MAX(|F_k|,|F_k+1|,1), where
*                                   SMALL is the smallest positive
*                                   number such that 1.0 + SMALL > 1.0.
*                              4  - Number of function calls > IPAR(3).
*                              5  - Number of iterations > IPAR(2).
*                              6  - Time limit exceeded.
*                              7  - F < RPAR(3).
*                             -1  - Two consecutive restarts or number
*                                   of restarts > maximum number of
*                                   restarts.
*                             -2  - TMAX < TMIN in two subsequent
*                                   iterations.
*                             -3  - Failure in function or subgradient
*                                   calculations (assigned by the user).
*                             -4  - Failure in attaining the demanded
*                                   accuracy.
*                             -5  - Invalid input parameters.
*                             -6  - Not enough working space.
*     RA  W(NW)         Work vector.
*     II  NW            Dimension of the work vector W:
*                         NW >= 1 + 9*N + 2*N*NA + 3*NA + 2*N*(MCU+1)
*                               + 3*(MCU+2)*(MCU+1)/2 + 9*(MCU+1)
*
*
*     * Subprograms used *
*
*     S   LMBM         Limited memory bundle method for nonsmooth
*                        optimization.
*     S   WPRINT       Printout the error and warning messages.
*     S   GETIME       Execution time.
*
*
*
*     Napsu Karmitsa (2002 - 2004, last modified 2007)
*

      SUBROUTINE LMBMU(N,NA,MCU,MC,NW,X,F,RPAR,IPAR,IOUT,TIME,RTIM,W)

*     Scalar Arguments
      INTEGER N,NA,MC,MCU,NW
      DOUBLE PRECISION F

*     Array Arguments
      INTEGER IPAR(*),IOUT(*)
      DOUBLE PRECISION X(*),RPAR(*),W(*)

*     Local Scalars
      INTEGER LXO,LS,LG,LGP,LGA,LU,LD,LAX,LAG,LAF,LSM,LUM,LRM,LUMTUM,
     &     LC,LSMTGP,LUMTGP,LTMC1,LTMC2,LTMC3,LTMC4,LTMC5,LTMC6,LTN1,
     &     LTN2,LTMAT

*     External Subroutines
      EXTERNAL LMBM,WPRINT,GETIME

*     CPU-time
      REAL TIME,START,FINI
      REAL RTIM(2)

*
*     CPU-time
*

      CALL GETIME(START,RTIM)

*
*     Initialization and error checking
*

      IOUT(3) = 0

      IF (N .LE. 0) THEN
         IOUT(3) = -5
         CALL WPRINT(IOUT(3),IPAR(5),1)
         RETURN
      END IF

      IF (MCU .LT. 3) THEN
         IOUT(3) = -5
         CALL WPRINT(IOUT(3),IPAR(5),2)
         RETURN
      END IF

      IF (NA .LT. 2) THEN
         IOUT(3) = -5
         CALL WPRINT(IOUT(3),IPAR(5),3)
         RETURN
      END IF

      IF (RPAR(7) .GE. 0.25D+00) THEN
         IOUT(3) = -5
         CALL WPRINT(IOUT(3),IPAR(5),4)
         RETURN
      END IF

      IF (NW .LT. 1 + 9*N + 2*N*NA + 3*NA + 2*N*(MCU+1) +
     &     3*(MCU+2)*(MCU+1)/2 + 9*(MCU+1)) THEN
         IOUT(3) = -6
         CALL WPRINT(IOUT(3),IPAR(5),0)
         RETURN
      END IF

      IF (IPAR(6) .GT. 1 .OR. IPAR(6) .LT. 0) IPAR(6) = 0
      IF (IPAR(7) .GT. 6 .OR. IPAR(7) .LT. 0) IPAR(7) = 2

      IF (MC .GT. MCU) THEN
         MC = MCU
         CALL WPRINT(IOUT(3),IPAR(5),-1)
      END IF

      IF (MC .LE. 0) MC = 3

*
*     Pointers for working array W
*

      LXO    = 1
      LS     = LXO    + N
      LG     = LS     + N
      LGP    = LG     + N
      LGA    = LGP    + N
      LU     = LGA    + N
      LD     = LU     + N
      LAX    = LD     + N
      LAG    = LAX    + N*NA
      LAF    = LAG    + N*NA
      LSM    = LAF    + 3*NA
      LUM    = LSM    + N*(MCU+1)
      LRM    = LUM    + N*(MCU+1)
      LUMTUM = LRM    + (MCU+2)*(MCU+1)/2
      LC     = LUMTUM + (MCU+2)*(MCU+1)/2
      LSMTGP = LC     + MCU+1
      LUMTGP = LSMTGP + MCU+1
      LTMC1  = LUMTGP + MCU+1
      LTMC2  = LTMC1  + MCU+1
      LTMC3  = LTMC2  + MCU+1
      LTMC4  = LTMC3  + MCU+1
      LTMC5  = LTMC4  + MCU+1
      LTMC6  = LTMC5  + MCU+1
      LTN1   = LTMC6  + MCU+1
      LTN2   = LTN1   + N
      LTMAT  = LTN2   + N

*
*     Solution
*

      CALL LMBM(N,NA,MC,MCU,X,W(LXO),W(LS),W(LG),W(LGP),W(LGA),W(LU),
     &     W(LD),F,W(LAX),W(LAG),W(LAF),W(LSM),W(LUM),W(LRM),W(LUMTUM),
     &     W(LC),W(LSMTGP),W(LUMTGP),W(LTMC1),W(LTMC2),W(LTMC3),W(LTMC4)
     &     ,W(LTMC5),W(LTMC6),W(LTN1),W(LTN2),W(LTMAT),RPAR(1),RPAR(2),
     &     RPAR(3),RPAR(4),RPAR(5),RPAR(6),RPAR(7),RPAR(8),IPAR(2),
     &     IPAR(3),IPAR(1),IPAR(4),IPAR(5),IPAR(6),IPAR(7),IOUT(1),
     &     IOUT(2),IOUT(3),TIME,RTIM)

*
*     CPU-time
*

      CALL GETIME(FINI,RTIM)
      RTIM(1) = FINI - START

      RETURN
      END

************************************************************************
*
*     * SUBROUTINE LMBM *
*
*
*     * Purpose *
*
*     Limited memory bundle subroutine for nonsmooth optimization.
*
*
*     * Calling sequence *
*
*     CALL LMBM(N,NA,MC,MCU,X,XO,S,G,GP,GA,U,D,F,AX,AG,AF,SM,UM,RM,
*    &     UMTUM,C,SMTGP,UMTGP,TMPMC1,TMPMC2,TMPMC3,TMPMC4,TMPMC5,
*    &     TMPMC6,TMPN1,TMPN2,TMPMAT,TOLF,TOLB,TOLG,TOLG2,ETA,EPSL,
*    &     XMAX,MIT,MFE,MOS,MTESF,IPRINT,METHOD,ISCALE,NIT,NFE,ITERM,
*    &     TIME,RTIM)
*
*
*     * Parameters *
*
*     II  N               Number of variables.
*     II  NA              Maximum bundle dimension.
*     IU  MC              Maximum number of stored corrections.
*     II  MCU             Upper limit for maximum number of stored
*                           corrections, MCU >= MC.
*     RU  X(N)            Vector of variables.
*     RA  XO(N)           Previous vector of variables.
*     RA  G(N)            Subgradient of the objective function.
*     RA  GP(N)           Previous subgradient of the objective function.
*     RA  GA(N)           Aggregate subgradient.
*     RA  S(N)            Difference of current and previous variables.
*     RA  U(N)            Difference of current and previous
*                           subgradients.
*     RA  D(N)            Search direction.
*     RO  F               Value of the objective function.
*     RA  AX(N*NA)        Matrix whose columns are bundle points.
*     RA  AG(N*NA)        Matrix whose columns are bundle subgradients.
*     RA  AF(3*NA)        Vector of bundle values.
*     RA  SM(N*(MC+1))    Matrix whose columns are stored differences of
*                           variables.
*     RA  UM(N*(MC+1))    Matrix whose columns are stored subgradient
*                           differences.
*     RA  RM((MC+2)*(MC+1)/2)  Upper triangular matrix stored columnwise
*                                in the one-dimensional array.
*     RU  UMTUM((MC+2)*(MC+1)/2)  Auxiliary matrix: TRANS(UM)*UM.
*     RU  C(MC+1)         Diagonal matrix.
*     RU  SMTGP(MC+1)     Auxiliary vector.
*     RU  UMTGP(MC+1)     Auxiliary vector.
*     RA  TMPMC#(MC+1)    Auxiliary arrays; # = 1,...,6.
*     RA  TMPN#(N)        Auxiliary arrays; # = 1,2.
*     RA  TMPMAT((MC+1)*(MC)/2)   Auxiliary matrix.
*     RI  TIME            Maximum CPU-time in seconds. If TIME <= 0.0
*                           the maximum time is ignored. REAL argument.
*     RI  RTIM(2)         Auxiliary array. REAL array.
*                           On input RTIM(1) contains the starting time.
*     RI  TOLF            Tolerance for change of function values.
*     RI  TOLF2           Second tolerance for change of function
*                           values.
*     RI  TOLB            Tolerance for the function value.
*     RI  TOLG            Tolerance for the first termination criterion.
*     RI  TOLG2           Tolerance for the second termination criterion.
*     RI  ETA             Distance measure parameter, ETA >= 0.
*     RI  EPSL            Line search parameter, 0 < EPSL < 0.25.
*     RI  XMAX            Maximum stepsize, 1 < XMAX.
*     II  MIT             Maximun number of iterations.
*     II  MFE             Maximun number of function evaluations.
*     II  MOS             Exponent for distance measure.
*     II  MTESF           Maximum number of iterations with changes of
*                           function values smaller than TOLF.
*     II  IPRINT          Printout specification:
*                            -1  - No printout.
*                             0  - Only the error messages.
*                             1  - The final values of the objective
*                                  function.
*                             2  - The final values of the objective
*                                  function and the most serious
*                                  warning messages.
*                             3  - The whole final solution.
*                             4  - At each iteration values of the
*                                  objective function.
*                             5  - At each iteration the whole
*                                  solution
*     II  METHOD          Selection of the method:
*                             0  - Limited memory bundle method.
*                             1  - L-BFGS bundle method.
*     II  ISCALE          Selection of the scaling:
*                             0  - Scaling at every iteration
*                                  with STU/UTU.
*                             1  - Scaling at every iteration
*                                  with STS/STU.
*                             2  - Interval scaling with STU/UTU.
*                             3  - Interval scaling with STS/STU.
*                             4  - Preliminary scaling with STU/UTU.
*                             5  - Preliminary scaling with STS/STU.
*                             6  - No scaling.
*     IO  NIT             Number of used iterations.
*     IO  NFE             Number of used function evaluations.
*     IO  ITERM           Cause of termination:
*                             1  - The problem has been solved.
*                                  with desired accuracy.
*                             2  - (F - FO) < TOLF in MTESF
*                                  subsequent iterations.
*                             3  - (F - FO) < TOLF*SMALL*MAX(|F|,|FO|,1).
*                             4  - Number of function calls > MFE.
*                             5  - Number of iterations > MIT.
*                             6  - Time limit exceeded.
*                             7  - F < TOLB.
*                            -1  - Two consecutive restarts.
*                            -2  - Number of restarts > maximum number
*                                  of restarts.
*                            -3  - Failure in function or subgradient
*                                  calculations (assigned by the user).
*                            -4  - Failure in attaining the demanded
*                                  accuracy.
*                            -5  - Invalid input parameters.
*                            -6  - Not enough working space.
*
*
*     * Local parameters *
*
*     I   MAXEPS          Maximum number of consecutive equal stopping
*                           criterions.
*     I   MAXNRS          Maximum number of restarts.
*     R   ETA9            Maximum for real numbers.
*     R   FMIN            Smallest acceptable value of the function.
*     R   TMIN            Minimum stepsize.
*     R   LENGTHD         Direction vector length.
*     R   RHO             Correction parameter.
*
*
*     * Local variables *
*
*     I   INEW            Index for the circular arrays.
*     I   IBUN            Index for the circular arrays in bundle.
*     I   IBFGS           Index of the type of BFGS update.
*     I   ISR1            Index of the type of SR1 update.
*     I   ITERS           Null step indicator.
*                              0  - Null step.
*                              1  - Serious step.
*     I   IC              Correction indicator.
*     I   ICN             Correction indicator for null steps.
*     I   IFLAG           Index for adaptive version:
*                              0  - Maximum number of stored corrections
*                                     has not been changed.
*                              1  - Maximum number of stored corrections
*                                     has been changed.
*     I   NAC             Current size of the bundle.
*     I   MCC             Current number of stored corrections.
*     I   MCINIT          Initial maximum number of stored corrections.
*     I   NEPS            Number of consecutive equal stopping
*                           criterions.
*     I   NNK             Consecutive null steps counter.
*     I   NRES            Number of consecutive restarts.
*     I   NRESS           Number of consecutive restarts in case of
*                           TMAX<TMIN.
*     I   NCRES           Number of restars.
*     I   NTESF           Number of tests on function decrease.
*     R   ALFN            Locality measure.
*     R   ALFV            Aggregate locality measure.
*     R   EPSR            Line search parameter.
*     R   GAMMA           Scaling parameter.
*     R   P               Directional derivative.
*     R   FO              Previous value of objective function.
*     R   DNORM           Euclidean norm of the direction vector.
*     R   GNORM           Euclidean norm of the aggregate subgradient
*                           vector.
*     R   XNORM           Stopping criterion.
*     R   PXNORM          Previous stopping criterion.
*     R   T               Stepsize.
*     R   TMAX            Maximum stepsize.
*     R   THETA           Correction parameter for stepsize.
*     R   SMALL           The smallest positive number such that
*                           1.0 + SMALL > 1.0.
*
*
*
*     * Subprograms used *
*
*     S   AGBFGS          Simplified subgradient aggregation.
*     S   AGGSR1          Subgradient aggregation.
*     S   AGSKIP          Subgradient aggregation using BFGS update.
*     S   DLBFGS          Computing the search direction by limited
*                           memory BFGS update.
*     S   DLSKIP          Skipping the updates and computing the search
*                           direction by limited memory BFGS update.
*     S   DLSR1           Computing the search direction by limited
*                           memory SR1 update.
*     S   DOBUN           Bundle selection.
*     S   LLS             Line search using function values and
*                           derivatives.
*     S   RESTAR          Initialization.
*     S   TINIT           Calculation of initial step size.
*     S   COPY            Copying of a vector.
*     S   GETIME          Execution time.
*     S   XDIFFY          Difference of two vectors.
*     S   RPRINT          Printout the results.
*     S   WPRINT          Printout the error and warning messages.
*     RF  EPS0            The smallest positive number such that
*                           1.0 + EPS0 > 1.0.
*     RF  VDOT            Dot product of two vectors.
*
*
*     * EXTERNAL SUBROUTINES *
*
*     SE  FUNDER          Computation of the value and the subgradient of
*                         the objective function. Calling sequence:
*                         CALL FUNDER(N,X,F,G,ITERM), where N is a number of
*                         variables, X(N) is a vector of variables, F is
*                         the value of the objective function, G(N) is
*                         the subgradient of the objective function, and
*                         ITERM is the error indicator.
*
*
*
*     Napsu Karmitsa (2002 - 2004, last modified 2007)
*
*

      SUBROUTINE LMBM(N,NA,MC,MCU,X,XO,S,G,GP,GA,U,D,F,AX,AG,AF,SM,UM,
     &     RM,UMTUM,C,SMTGP,UMTGP,TMPMC1,TMPMC2,TMPMC3,TMPMC4,TMPMC5,
     &     TMPMC6,TMPN1,TMPN2,TMPMAT,TOLF,TOLF2,TOLB,TOLG,TOLG2,ETA,
     &     EPSL,XMAX,MIT,MFE,MOS,MTESF,IPRINT,METHOD,ISCALE,NIT,NFE,
     &     ITERM,TIME,RTIM)

*     Scalar Arguments
      INTEGER N,NA,MC,MCU,MIT,MFE,MOS,MTESF,IPRINT,NIT,NFE,ITERM,METHOD
     &     ,ISCALE
      DOUBLE PRECISION F,ETA,EPSL,TOLF,TOLF2,TOLB,TOLG,TOLG2,XMAX

*     Array Arguments
      DOUBLE PRECISION X(*),XO(*),S(*),G(*),GP(*),GA(*),U(*),D(*),
     &     AX(*),AG(*),AF(*),SM(*),UM(*),RM(*),UMTUM(*),C(*),
     &     SMTGP(*),UMTGP(*),TMPMC1(*),TMPMC2(*),TMPMC3(*),TMPMC4(*),
     &     TMPMC5(*),TMPMC6(*),TMPN1(*),TMPN2(*),TMPMAT(*)

*     Local Scalars
      INTEGER I,INEW,IBFGS,ISR1,ITERS,MAL,MCC,MCINIT,NNK,NTESF,NRES,
     &     NCRES,IC,ICN,NRESS,NEPS,IFLAG,IBUN,NOUT
      DOUBLE PRECISION ALFN,ALFV,EPSR,DNORM,GNORM,XNORM,P,TMAX,T,
     &     FO,GAMMA,PXNORM,THETA,SMALL

*     External Functions
      DOUBLE PRECISION VDOT,EPS0
      EXTERNAL VDOT,EPS0

*     External Subroutines
      EXTERNAL FUNDER,COPY,XDIFFY,DLBFGS,DLSKIP,DLSR1,
     &     LLS,AGBFGS,AGGSR1,AGSKIP,DOBUN,TINIT,RESTAR,COPY2,
     &     RPRINT,WPRINT,GETIME

*     Intrinsic Functions
      INTRINSIC ABS,MAX,SQRT

*     Computational Time
      REAL TIME,STRTIM,CTIM,RTIM(2)

*     Parameters
      INTEGER MAXEPS,MAXNRS
      DOUBLE PRECISION ETA9,FMIN,TMIN,LENGTHD,RHO
      PARAMETER(
     &     MAXEPS = 20,
     &     MAXNRS = 2000,
     &     ETA9 = 1.0D+60,
     &     FMIN = -1.0D+60,
     &     TMIN = 1.0D-12,
     &     LENGTHD = 1.0D+20,
     &     RHO = 1.0D-12)

      IF (IPRINT .GT. 3) THEN
         IF (METHOD .EQ. 0) WRITE (6,FMT='(1X,''Entry to LMBM:'')')
         IF (METHOD .EQ. 1) WRITE (6,FMT='(1X,''Entry to LBB:'')')
      END IF

*
*     Initialization
*

      NOUT = 0
      NIT = 0
      NFE = 0
      NTESF = 0
      NRES = 1
      NCRES = -1
      NRESS = 0
      NEPS = 0
      ITERM = 0
      ITERS = 1
      NNK = 0
      ISR1 = 0
      ALFN = 0.0D+00
      ALFV = 0.0D+00
      MCINIT=MC

      SMALL = EPS0()
      STRTIM = RTIM(1)

      IF (TOLF  .LE. 0.0D+00) TOLF = 1.0D-8
      IF (TOLF2 .EQ. 0.0D+00) TOLF2 = 1.0D+04
      IF (TOLB  .EQ. 0.0D+00) TOLB = FMIN + SMALL
      IF (TOLG  .LE. 0.0D+00) TOLG = 1.0D-06
      IF (TOLG2 .LE. 0.0D+00) TOLG2 = TOLG
      IF (XMAX  .LE. 0.0D+00) XMAX = 1.5D+00
      IF (ETA   .LT. 0.0D+00) ETA = 0.50D+00
      IF (EPSL  .LE. 0.0D+00) EPSL = 1.0D-04
      IF (MOS   .LE. 0) MOS = 2
      IF (MTESF .LE. 0) MTESF = 10
      IF (MIT   .LE. 0) MIT = 10000
      IF (MFE   .LE. 0) MFE = 20000

      TMAX = XMAX
      XNORM = ETA9

      EPSR = 0.25D+00+SMALL
      IF (2.0D+00*EPSL .GE. EPSR) THEN
         EPSR = 2.0D+00*EPSL + SMALL
         IF (EPSR .GE. 0.5D+00) THEN
            CALL WPRINT(ITERM,IPRINT,-2)
         END IF
      END IF

*
*     Computation of the value and the subgradient of the objective
*     function and the search direction for the first iteration
*

      CALL FUNDER(N,X,F,G,ITERM)
      NFE = NFE + 1

      IF (ITERM .NE. 0) GOTO 900

      CALL RESTAR(N,MC,MCC,MCINIT,INEW,IBUN,IBFGS,ITERS,GP,G,NNK,
     &     ALFV,ALFN,GAMMA,D,IC,ICN,MAL,NCRES,IFLAG)

      CALL DOBUN(N,NA,MAL,X,G,F,AX,AG,AF,ITERS,IBUN)

      GOTO 200

*
*     Start of the iteration
*

 100  CONTINUE

*
*     Serious step initialization
*

      IF (ITERS.GT.0) THEN
         ICN = 0
         ALFN = 0.0D+00
         ALFV = 0.0D+00
      END IF

*
*     Direction finding
*

      IF (ITERS.GT.0) THEN

*
*     BFGS update and direction determination
*

         CALL DLBFGS(N,MC,MCC,INEW,IBFGS,IFLAG,D,G,GP,S,U,SM,UM,RM,
     &        UMTUM,C,SMTGP,UMTGP,GAMMA,TMPMC1,TMPMC2,TMPMC3,
     &        TMPMC4,TMPN1,SMALL,METHOD,ISCALE)

      ELSE
         IF (METHOD .EQ. 0) THEN

*
*     SR1 update and direction determination
*

            CALL DLSR1(N,MC,MCC,INEW,ISR1,IFLAG,D,GP,GA,S,U,SM,UM,RM,
     &           UMTUM,C,SMTGP,UMTGP,GAMMA,TMPMC1,TMPMC2,TMPMC3,TMPMC4,
     &           TMPMC5,TMPMC6,TMPN1,TMPN2,TMPMAT,NNK,SMALL,IPRINT)
            IBFGS=0
         ELSE

*
*     BFGS skipping and direction determination
*

            CALL DLSKIP(N,MC,MCC,INEW,IBFGS,IFLAG,D,GA,SM,UM,RM,
     &           UMTUM,C,TMPMC1,TMPMC2,GAMMA,TMPMC3,TMPMC4,TMPMC5,
     &           TMPN1,ISCALE)

         END IF
      END IF

 200  CONTINUE

*
*     Computational time
*

      IF (TIME .GT. 0.0E+00) THEN
         CALL GETIME(CTIM,RTIM)
         IF (CTIM-STRTIM .GT. TIME) THEN
            ITERM = 6
            GOTO 900
         END IF
      END IF

*
*     Computation of norms
*

      IF (ITERS .GT. 0) THEN
         GNORM = VDOT(N,G,G)
         DNORM = SQRT(VDOT(N,D,D))

         P = VDOT(N,G,D)

      ELSE
         GNORM = VDOT(N,GA,GA)
         DNORM = SQRT(VDOT(N,D,D))

         P = VDOT(N,GA,D)
      END IF

*
*     Test on descent direction
*

      IF (P+SMALL*SQRT(GNORM)*DNORM .LE. 0.0D+00) THEN
         NRES = 0

      ELSE
         NRES = NRES + 1
         IF (NRES .EQ. 1) THEN
            CALL WPRINT(ITERM,IPRINT,-3)

            CALL RESTAR(N,MC,MCC,MCINIT,INEW,IBUN,IBFGS,ITERS,GP,G,NNK,
     &           ALFV,ALFN,GAMMA,D,IC,ICN,MAL,NCRES,IFLAG)
            IF (NCRES .GT. MAXNRS) THEN
               NOUT = MAXNRS
               ITERM = -2
               GO TO 900
            END IF

            CALL DOBUN(N,NA,MAL,X,G,F,AX,AG,AF,ITERS,IBUN)

            GOTO 200
         END IF
         NOUT = -1
         ITERM = -1
         GOTO 900
      END IF

*
*     Stopping criterion
*

      NIT = NIT + 1
      PXNORM = XNORM
      XNORM = -P + 2.0D+00*ALFV

*
*     Tests for termination
*

      IF (XNORM .LE. 1.0D+03*TOLG .AND.
     &     (MCC .GT. 0 .OR. IBFGS .EQ. 2)) THEN

         IF(0.5D+00*GNORM + ALFV .LE. TOLG2 .AND.
     &        XNORM .LE. TOLG) THEN

            ITERM = 1
            GOTO 900
         END IF

         IF (MC .LT. MCU .AND. IFLAG .EQ. 0) THEN
            MC=MC+1
            IFLAG=1
         END IF
      END IF

      IF (NFE.GE.MFE) THEN
         NOUT = MFE
         ITERM = 4
         GOTO 900
      END IF

      IF (NIT.GE.MIT) THEN
         NOUT = MIT
         ITERM = 5
         GOTO 900
      END IF

      IF (F.LE.TOLB) THEN
         ITERM = 7
         GOTO 900
      END IF

      IF (ITERS .EQ. 0) THEN
         IF (ABS(XNORM - PXNORM) .LE. SMALL) THEN
            NEPS = NEPS + 1

            IF (NEPS .GT. MAXEPS) THEN
               ITERM = -4
               GOTO 900
            END IF

         ELSE
            NEPS = 0
         END IF

      ELSE
         NEPS = 0
      END IF

*
*     Correction
*

      IF (-P .LT. RHO*GNORM .OR. ICN .EQ. 1) THEN

         XNORM =XNORM + RHO*GNORM
         DNORM=SQRT(DNORM*DNORM-2*RHO*P+RHO*RHO*GNORM)

         IF (ITERS .GT. 0) THEN
            DO 230 I=1,N
               D(I)=D(I)-RHO*G(I)
 230        CONTINUE

         ELSE
            DO 240 I=1,N
               D(I)=D(I)-RHO*GA(I)
 240        CONTINUE
            ICN = 1
         END IF

         IC=1

      ELSE
         IC=0
      END IF

      IF (PXNORM .LT. XNORM .AND. NNK .GT. 2) THEN
         CALL WPRINT(ITERM,IPRINT,-4)
      END IF

      CALL RPRINT(N,NIT,NFE,X,F,XNORM,0.5D+00*GNORM+ALFV,ITERM,IPRINT)

*
*     Preparation of line search
*

      FO = F

      IF (ITERS .GT. 0) THEN
         CALL COPY2(N,X,XO,G,GP)
      END IF

      IF (DNORM.GT.0.0D+00) TMAX = XMAX/DNORM

      IF (TMAX .GT. TMIN) THEN
         NRESS = 0

      ELSE
         NRESS = NRESS + 1
         IF (NRESS .EQ. 1) THEN
            CALL WPRINT(ITERM,IPRINT,-5)

            CALL RESTAR(N,MC,MCC,MCINIT,INEW,IBUN,IBFGS,ITERS,GP,G,NNK,
     &           ALFV,ALFN,GAMMA,D,IC,ICN,MAL,NCRES,IFLAG)

            IF (NCRES .GT. MAXNRS) THEN
               NOUT = MAXNRS
               ITERM = -2
               GO TO 900
            END IF

            CALL DOBUN(N,NA,MAL,X,G,F,AX,AG,AF,ITERS,IBUN)

            GOTO 200
         END IF
         ITERM = -1
         GOTO 900
      END IF

*
*     Initial step size
*

      CALL TINIT(N,NA,MAL,X,AF,AG,AX,IBUN,D,F,P,T,TMAX,TMIN,
     &     ETA,ETA9,MOS,ITERS)

*
*     Line search with directional derivatives which allows null steps
*

      THETA=1.0D+00
      IF (DNORM .GT. LENGTHD) THEN
         THETA=LENGTHD/DNORM
      END IF

      CALL LLS(N,X,G,D,XO,T,FO,F,P,ALFN,TMIN,
     &     DNORM,XNORM,THETA,EPSL,EPSR,ETA,MOS,ITERS,NFE,NNK,ITERM)

      IF (ITERM .NE. 0) GOTO 900

      IF (TOLF2 .GE. 0) THEN
         IF (ABS(FO-F) .LE. TOLF2*SMALL*MAX(ABS(F),ABS(FO),1.0D+00)
     &        .AND. ITERS .EQ. 1) THEN

            ITERM = 3
            GOTO 900

         END IF
      END IF

      IF (ABS(FO-F) .LE. TOLF) THEN
         NTESF = NTESF + 1

         IF (NTESF .GE. MTESF .AND. ITERS .EQ. 1) THEN
            ITERM = 2
            GOTO 900
         END IF

      ELSE
         NTESF = 0
      END IF

*
*     Bundle updating
*

      CALL DOBUN(N,NA,MAL,X,G,F,AX,AG,AF,ITERS,IBUN)

*
*     Computation of variables difference
*

      CALL XDIFFY(N,X,XO,S)

*
*     Computation of aggregate values and gradients difference
*

      IF (ITERS.EQ.0) THEN
         NNK = NNK + 1

         IF (NNK.EQ.1) THEN
            CALL COPY(N,GP,TMPN1)
            CALL XDIFFY(N,G,GP,U)
            CALL AGBFGS(N,MC,MCC,INEW,IBFGS,IFLAG,G,GP,GA,U,D,SM,UM,
     &           RM,C,UMTUM,ALFN,ALFV,GAMMA,TMPMC1,TMPMC2,IC,RHO)

         ELSE
            IF (METHOD .EQ. 0) THEN
               CALL COPY(N,GA,TMPN1)
               CALL AGGSR1(N,MC,MCC,INEW,IFLAG,G,GP,GA,D,ALFN,ALFV
     &              ,TMPMAT,UMTUM,RM,GAMMA,SMTGP,UMTGP,TMPMC1,TMPMC2,SM
     &              ,UM,TMPMC3,TMPMC4,TMPN2,X,U,ICN,RHO,SMALL)
               CALL XDIFFY(N,G,GP,U)
            ELSE
               CALL COPY(N,GA,TMPN1)
               CALL XDIFFY(N,G,GP,U)
               CALL AGSKIP(N,MC,MCC,INEW,IFLAG,G,GP,GA,D,U,ALFN,ALFV
     &              ,UMTUM,RM,C,GAMMA,SMTGP,UMTGP,TMPMC1,TMPMC2,SM
     &              ,UM,TMPMC3,TMPMC4,TMPN2,ICN,RHO,SMALL)
            END IF
         END IF

         CALL COPY(N,XO,X)
         F = FO

      ELSE
         IF (NNK .NE. 0) THEN
            CALL COPY(N,GA,TMPN1)
         ELSE
            CALL COPY(N,GP,TMPN1)
         END IF
         NNK = 0
         CALL XDIFFY(N,G,GP,U)
      END IF

      GOTO 100

 900  CONTINUE

*
*     Printout the final results
*

      IF (IPRINT .GT. 3) THEN
         IF (METHOD .EQ. 0) WRITE (6,FMT='(1X,''Exit from LMBM:'')')
         IF (METHOD .EQ. 1) WRITE (6,FMT='(1X,''Exit from LBB:'')')
      END IF
      CALL WPRINT(ITERM,IPRINT,NOUT)
      CALL RPRINT(N,NIT,NFE,X,F,XNORM,0.5D+00*GNORM+ALFV,ITERM,IPRINT)

      RETURN
      END

************************************************************************


module kernels
implicit none
contains

subroutine mulkernel_loop32(D, A, X)
    real(8), dimension(16,32),  intent(in)  :: A
    real(8), dimension(32,14),  intent(in)  :: X
    real(8), dimension(16,14),  intent(out) :: D
    integer                                 :: i

    D(1:16,1)  = A(1:16,1) * X(1,1)
    D(1:16,2)  = A(1:16,1) * X(1,2)
    D(1:16,3)  = A(1:16,1) * X(1,3)
    D(1:16,4)  = A(1:16,1) * X(1,4)
    D(1:16,5)  = A(1:16,1) * X(1,5)
    D(1:16,6)  = A(1:16,1) * X(1,6)
    D(1:16,7)  = A(1:16,1) * X(1,7)
    D(1:16,8)  = A(1:16,1) * X(1,8)
    D(1:16,9)  = A(1:16,1) * X(1,9)
    D(1:16,10) = A(1:16,1) * X(1,10)
    D(1:16,11) = A(1:16,1) * X(1,11)
    D(1:16,12) = A(1:16,1) * X(1,12)
    D(1:16,13) = A(1:16,1) * X(1,13)
    D(1:16,14) = A(1:16,1) * X(1,14)

    do i = 2, 32
        D(1:16,1)  = D(1:16,1)  + A(1:16,i) * X(i,1)
        D(1:16,2)  = D(1:16,2)  + A(1:16,i) * X(i,2)
        D(1:16,3)  = D(1:16,3)  + A(1:16,i) * X(i,3)
        D(1:16,4)  = D(1:16,4)  + A(1:16,i) * X(i,4)
        D(1:16,5)  = D(1:16,5)  + A(1:16,i) * X(i,5)
        D(1:16,6)  = D(1:16,6)  + A(1:16,i) * X(i,6)
        D(1:16,7)  = D(1:16,7)  + A(1:16,i) * X(i,7)
        D(1:16,8)  = D(1:16,8)  + A(1:16,i) * X(i,8)
        D(1:16,9)  = D(1:16,9)  + A(1:16,i) * X(i,9)
        D(1:16,10) = D(1:16,10) + A(1:16,i) * X(i,10)
        D(1:16,11) = D(1:16,11) + A(1:16,i) * X(i,11)
        D(1:16,12) = D(1:16,12) + A(1:16,i) * X(i,12)
        D(1:16,13) = D(1:16,13) + A(1:16,i) * X(i,13)
        D(1:16,14) = D(1:16,14) + A(1:16,i) * X(i,14)
    end do

end subroutine mulkernel_loop32

subroutine mulkernel(D, A, X)
    real(8), dimension(16,32),  intent(in)  :: A
    real(8), dimension(32,14),  intent(in)  :: X
    real(8), dimension(16,14),  intent(out) :: D

    D(1:16,1) = X(1,1) * A(1:16,1)
    D(1:16,2) = X(1,2) * A(1:16,1)
    D(1:16,3) = X(1,3) * A(1:16,1)
    D(1:16,4) = X(1,4) * A(1:16,1)
    D(1:16,5) = X(1,5) * A(1:16,1)
    D(1:16,6) = X(1,6) * A(1:16,1)
    D(1:16,7) = X(1,7) * A(1:16,1)
    D(1:16,8) = X(1,8) * A(1:16,1)
    D(1:16,9) = X(1,9) * A(1:16,1)
    D(1:16,10) = X(1,10) * A(1:16,1)
    D(1:16,11) = X(1,11) * A(1:16,1)
    D(1:16,12) = X(1,12) * A(1:16,1)
    D(1:16,13) = X(1,13) * A(1:16,1)
    D(1:16,14) = X(1,14) * A(1:16,1)

    D(1:16,1) = D(1:16,1) + X(2,1) * A(1:16,2)
    D(1:16,2) = D(1:16,2) + X(2,2) * A(1:16,2)
    D(1:16,3) = D(1:16,3) + X(2,3) * A(1:16,2)
    D(1:16,4) = D(1:16,4) + X(2,4) * A(1:16,2)
    D(1:16,5) = D(1:16,5) + X(2,5) * A(1:16,2)
    D(1:16,6) = D(1:16,6) + X(2,6) * A(1:16,2)
    D(1:16,7) = D(1:16,7) + X(2,7) * A(1:16,2)
    D(1:16,8) = D(1:16,8) + X(2,8) * A(1:16,2)
    D(1:16,9) = D(1:16,9) + X(2,9) * A(1:16,2)
    D(1:16,10) = D(1:16,10) + X(2,10) * A(1:16,2)
    D(1:16,11) = D(1:16,11) + X(2,11) * A(1:16,2)
    D(1:16,12) = D(1:16,12) + X(2,12) * A(1:16,2)
    D(1:16,13) = D(1:16,13) + X(2,13) * A(1:16,2)
    D(1:16,14) = D(1:16,14) + X(2,14) * A(1:16,2)

    D(1:16,1) = D(1:16,1) + X(3,1) * A(1:16,3)
    D(1:16,2) = D(1:16,2) + X(3,2) * A(1:16,3)
    D(1:16,3) = D(1:16,3) + X(3,3) * A(1:16,3)
    D(1:16,4) = D(1:16,4) + X(3,4) * A(1:16,3)
    D(1:16,5) = D(1:16,5) + X(3,5) * A(1:16,3)
    D(1:16,6) = D(1:16,6) + X(3,6) * A(1:16,3)
    D(1:16,7) = D(1:16,7) + X(3,7) * A(1:16,3)
    D(1:16,8) = D(1:16,8) + X(3,8) * A(1:16,3)
    D(1:16,9) = D(1:16,9) + X(3,9) * A(1:16,3)
    D(1:16,10) = D(1:16,10) + X(3,10) * A(1:16,3)
    D(1:16,11) = D(1:16,11) + X(3,11) * A(1:16,3)
    D(1:16,12) = D(1:16,12) + X(3,12) * A(1:16,3)
    D(1:16,13) = D(1:16,13) + X(3,13) * A(1:16,3)
    D(1:16,14) = D(1:16,14) + X(3,14) * A(1:16,3)

    D(1:16,1) = D(1:16,1) + X(4,1) * A(1:16,4)
    D(1:16,2) = D(1:16,2) + X(4,2) * A(1:16,4)
    D(1:16,3) = D(1:16,3) + X(4,3) * A(1:16,4)
    D(1:16,4) = D(1:16,4) + X(4,4) * A(1:16,4)
    D(1:16,5) = D(1:16,5) + X(4,5) * A(1:16,4)
    D(1:16,6) = D(1:16,6) + X(4,6) * A(1:16,4)
    D(1:16,7) = D(1:16,7) + X(4,7) * A(1:16,4)
    D(1:16,8) = D(1:16,8) + X(4,8) * A(1:16,4)
    D(1:16,9) = D(1:16,9) + X(4,9) * A(1:16,4)
    D(1:16,10) = D(1:16,10) + X(4,10) * A(1:16,4)
    D(1:16,11) = D(1:16,11) + X(4,11) * A(1:16,4)
    D(1:16,12) = D(1:16,12) + X(4,12) * A(1:16,4)
    D(1:16,13) = D(1:16,13) + X(4,13) * A(1:16,4)
    D(1:16,14) = D(1:16,14) + X(4,14) * A(1:16,4)

    D(1:16,1) = D(1:16,1) + X(5,1) * A(1:16,5)
    D(1:16,2) = D(1:16,2) + X(5,2) * A(1:16,5)
    D(1:16,3) = D(1:16,3) + X(5,3) * A(1:16,5)
    D(1:16,4) = D(1:16,4) + X(5,4) * A(1:16,5)
    D(1:16,5) = D(1:16,5) + X(5,5) * A(1:16,5)
    D(1:16,6) = D(1:16,6) + X(5,6) * A(1:16,5)
    D(1:16,7) = D(1:16,7) + X(5,7) * A(1:16,5)
    D(1:16,8) = D(1:16,8) + X(5,8) * A(1:16,5)
    D(1:16,9) = D(1:16,9) + X(5,9) * A(1:16,5)
    D(1:16,10) = D(1:16,10) + X(5,10) * A(1:16,5)
    D(1:16,11) = D(1:16,11) + X(5,11) * A(1:16,5)
    D(1:16,12) = D(1:16,12) + X(5,12) * A(1:16,5)
    D(1:16,13) = D(1:16,13) + X(5,13) * A(1:16,5)
    D(1:16,14) = D(1:16,14) + X(5,14) * A(1:16,5)

    D(1:16,1) = D(1:16,1) + X(6,1) * A(1:16,6)
    D(1:16,2) = D(1:16,2) + X(6,2) * A(1:16,6)
    D(1:16,3) = D(1:16,3) + X(6,3) * A(1:16,6)
    D(1:16,4) = D(1:16,4) + X(6,4) * A(1:16,6)
    D(1:16,5) = D(1:16,5) + X(6,5) * A(1:16,6)
    D(1:16,6) = D(1:16,6) + X(6,6) * A(1:16,6)
    D(1:16,7) = D(1:16,7) + X(6,7) * A(1:16,6)
    D(1:16,8) = D(1:16,8) + X(6,8) * A(1:16,6)
    D(1:16,9) = D(1:16,9) + X(6,9) * A(1:16,6)
    D(1:16,10) = D(1:16,10) + X(6,10) * A(1:16,6)
    D(1:16,11) = D(1:16,11) + X(6,11) * A(1:16,6)
    D(1:16,12) = D(1:16,12) + X(6,12) * A(1:16,6)
    D(1:16,13) = D(1:16,13) + X(6,13) * A(1:16,6)
    D(1:16,14) = D(1:16,14) + X(6,14) * A(1:16,6)

    D(1:16,1) = D(1:16,1) + X(7,1) * A(1:16,7)
    D(1:16,2) = D(1:16,2) + X(7,2) * A(1:16,7)
    D(1:16,3) = D(1:16,3) + X(7,3) * A(1:16,7)
    D(1:16,4) = D(1:16,4) + X(7,4) * A(1:16,7)
    D(1:16,5) = D(1:16,5) + X(7,5) * A(1:16,7)
    D(1:16,6) = D(1:16,6) + X(7,6) * A(1:16,7)
    D(1:16,7) = D(1:16,7) + X(7,7) * A(1:16,7)
    D(1:16,8) = D(1:16,8) + X(7,8) * A(1:16,7)
    D(1:16,9) = D(1:16,9) + X(7,9) * A(1:16,7)
    D(1:16,10) = D(1:16,10) + X(7,10) * A(1:16,7)
    D(1:16,11) = D(1:16,11) + X(7,11) * A(1:16,7)
    D(1:16,12) = D(1:16,12) + X(7,12) * A(1:16,7)
    D(1:16,13) = D(1:16,13) + X(7,13) * A(1:16,7)
    D(1:16,14) = D(1:16,14) + X(7,14) * A(1:16,7)

    D(1:16,1) = D(1:16,1) + X(8,1) * A(1:16,8)
    D(1:16,2) = D(1:16,2) + X(8,2) * A(1:16,8)
    D(1:16,3) = D(1:16,3) + X(8,3) * A(1:16,8)
    D(1:16,4) = D(1:16,4) + X(8,4) * A(1:16,8)
    D(1:16,5) = D(1:16,5) + X(8,5) * A(1:16,8)
    D(1:16,6) = D(1:16,6) + X(8,6) * A(1:16,8)
    D(1:16,7) = D(1:16,7) + X(8,7) * A(1:16,8)
    D(1:16,8) = D(1:16,8) + X(8,8) * A(1:16,8)
    D(1:16,9) = D(1:16,9) + X(8,9) * A(1:16,8)
    D(1:16,10) = D(1:16,10) + X(8,10) * A(1:16,8)
    D(1:16,11) = D(1:16,11) + X(8,11) * A(1:16,8)
    D(1:16,12) = D(1:16,12) + X(8,12) * A(1:16,8)
    D(1:16,13) = D(1:16,13) + X(8,13) * A(1:16,8)
    D(1:16,14) = D(1:16,14) + X(8,14) * A(1:16,8)

    D(1:16,1) = D(1:16,1) + X(9,1) * A(1:16,9)
    D(1:16,2) = D(1:16,2) + X(9,2) * A(1:16,9)
    D(1:16,3) = D(1:16,3) + X(9,3) * A(1:16,9)
    D(1:16,4) = D(1:16,4) + X(9,4) * A(1:16,9)
    D(1:16,5) = D(1:16,5) + X(9,5) * A(1:16,9)
    D(1:16,6) = D(1:16,6) + X(9,6) * A(1:16,9)
    D(1:16,7) = D(1:16,7) + X(9,7) * A(1:16,9)
    D(1:16,8) = D(1:16,8) + X(9,8) * A(1:16,9)
    D(1:16,9) = D(1:16,9) + X(9,9) * A(1:16,9)
    D(1:16,10) = D(1:16,10) + X(9,10) * A(1:16,9)
    D(1:16,11) = D(1:16,11) + X(9,11) * A(1:16,9)
    D(1:16,12) = D(1:16,12) + X(9,12) * A(1:16,9)
    D(1:16,13) = D(1:16,13) + X(9,13) * A(1:16,9)
    D(1:16,14) = D(1:16,14) + X(9,14) * A(1:16,9)

    D(1:16,1) = D(1:16,1) + X(10,1) * A(1:16,10)
    D(1:16,2) = D(1:16,2) + X(10,2) * A(1:16,10)
    D(1:16,3) = D(1:16,3) + X(10,3) * A(1:16,10)
    D(1:16,4) = D(1:16,4) + X(10,4) * A(1:16,10)
    D(1:16,5) = D(1:16,5) + X(10,5) * A(1:16,10)
    D(1:16,6) = D(1:16,6) + X(10,6) * A(1:16,10)
    D(1:16,7) = D(1:16,7) + X(10,7) * A(1:16,10)
    D(1:16,8) = D(1:16,8) + X(10,8) * A(1:16,10)
    D(1:16,9) = D(1:16,9) + X(10,9) * A(1:16,10)
    D(1:16,10) = D(1:16,10) + X(10,10) * A(1:16,10)
    D(1:16,11) = D(1:16,11) + X(10,11) * A(1:16,10)
    D(1:16,12) = D(1:16,12) + X(10,12) * A(1:16,10)
    D(1:16,13) = D(1:16,13) + X(10,13) * A(1:16,10)
    D(1:16,14) = D(1:16,14) + X(10,14) * A(1:16,10)

    D(1:16,1) = D(1:16,1) + X(11,1) * A(1:16,11)
    D(1:16,2) = D(1:16,2) + X(11,2) * A(1:16,11)
    D(1:16,3) = D(1:16,3) + X(11,3) * A(1:16,11)
    D(1:16,4) = D(1:16,4) + X(11,4) * A(1:16,11)
    D(1:16,5) = D(1:16,5) + X(11,5) * A(1:16,11)
    D(1:16,6) = D(1:16,6) + X(11,6) * A(1:16,11)
    D(1:16,7) = D(1:16,7) + X(11,7) * A(1:16,11)
    D(1:16,8) = D(1:16,8) + X(11,8) * A(1:16,11)
    D(1:16,9) = D(1:16,9) + X(11,9) * A(1:16,11)
    D(1:16,10) = D(1:16,10) + X(11,10) * A(1:16,11)
    D(1:16,11) = D(1:16,11) + X(11,11) * A(1:16,11)
    D(1:16,12) = D(1:16,12) + X(11,12) * A(1:16,11)
    D(1:16,13) = D(1:16,13) + X(11,13) * A(1:16,11)
    D(1:16,14) = D(1:16,14) + X(11,14) * A(1:16,11)

    D(1:16,1) = D(1:16,1) + X(12,1) * A(1:16,12)
    D(1:16,2) = D(1:16,2) + X(12,2) * A(1:16,12)
    D(1:16,3) = D(1:16,3) + X(12,3) * A(1:16,12)
    D(1:16,4) = D(1:16,4) + X(12,4) * A(1:16,12)
    D(1:16,5) = D(1:16,5) + X(12,5) * A(1:16,12)
    D(1:16,6) = D(1:16,6) + X(12,6) * A(1:16,12)
    D(1:16,7) = D(1:16,7) + X(12,7) * A(1:16,12)
    D(1:16,8) = D(1:16,8) + X(12,8) * A(1:16,12)
    D(1:16,9) = D(1:16,9) + X(12,9) * A(1:16,12)
    D(1:16,10) = D(1:16,10) + X(12,10) * A(1:16,12)
    D(1:16,11) = D(1:16,11) + X(12,11) * A(1:16,12)
    D(1:16,12) = D(1:16,12) + X(12,12) * A(1:16,12)
    D(1:16,13) = D(1:16,13) + X(12,13) * A(1:16,12)
    D(1:16,14) = D(1:16,14) + X(12,14) * A(1:16,12)

    D(1:16,1) = D(1:16,1) + X(13,1) * A(1:16,13)
    D(1:16,2) = D(1:16,2) + X(13,2) * A(1:16,13)
    D(1:16,3) = D(1:16,3) + X(13,3) * A(1:16,13)
    D(1:16,4) = D(1:16,4) + X(13,4) * A(1:16,13)
    D(1:16,5) = D(1:16,5) + X(13,5) * A(1:16,13)
    D(1:16,6) = D(1:16,6) + X(13,6) * A(1:16,13)
    D(1:16,7) = D(1:16,7) + X(13,7) * A(1:16,13)
    D(1:16,8) = D(1:16,8) + X(13,8) * A(1:16,13)
    D(1:16,9) = D(1:16,9) + X(13,9) * A(1:16,13)
    D(1:16,10) = D(1:16,10) + X(13,10) * A(1:16,13)
    D(1:16,11) = D(1:16,11) + X(13,11) * A(1:16,13)
    D(1:16,12) = D(1:16,12) + X(13,12) * A(1:16,13)
    D(1:16,13) = D(1:16,13) + X(13,13) * A(1:16,13)
    D(1:16,14) = D(1:16,14) + X(13,14) * A(1:16,13)

    D(1:16,1) = D(1:16,1) + X(14,1) * A(1:16,14)
    D(1:16,2) = D(1:16,2) + X(14,2) * A(1:16,14)
    D(1:16,3) = D(1:16,3) + X(14,3) * A(1:16,14)
    D(1:16,4) = D(1:16,4) + X(14,4) * A(1:16,14)
    D(1:16,5) = D(1:16,5) + X(14,5) * A(1:16,14)
    D(1:16,6) = D(1:16,6) + X(14,6) * A(1:16,14)
    D(1:16,7) = D(1:16,7) + X(14,7) * A(1:16,14)
    D(1:16,8) = D(1:16,8) + X(14,8) * A(1:16,14)
    D(1:16,9) = D(1:16,9) + X(14,9) * A(1:16,14)
    D(1:16,10) = D(1:16,10) + X(14,10) * A(1:16,14)
    D(1:16,11) = D(1:16,11) + X(14,11) * A(1:16,14)
    D(1:16,12) = D(1:16,12) + X(14,12) * A(1:16,14)
    D(1:16,13) = D(1:16,13) + X(14,13) * A(1:16,14)
    D(1:16,14) = D(1:16,14) + X(14,14) * A(1:16,14)

    D(1:16,1) = D(1:16,1) + X(15,1) * A(1:16,15)
    D(1:16,2) = D(1:16,2) + X(15,2) * A(1:16,15)
    D(1:16,3) = D(1:16,3) + X(15,3) * A(1:16,15)
    D(1:16,4) = D(1:16,4) + X(15,4) * A(1:16,15)
    D(1:16,5) = D(1:16,5) + X(15,5) * A(1:16,15)
    D(1:16,6) = D(1:16,6) + X(15,6) * A(1:16,15)
    D(1:16,7) = D(1:16,7) + X(15,7) * A(1:16,15)
    D(1:16,8) = D(1:16,8) + X(15,8) * A(1:16,15)
    D(1:16,9) = D(1:16,9) + X(15,9) * A(1:16,15)
    D(1:16,10) = D(1:16,10) + X(15,10) * A(1:16,15)
    D(1:16,11) = D(1:16,11) + X(15,11) * A(1:16,15)
    D(1:16,12) = D(1:16,12) + X(15,12) * A(1:16,15)
    D(1:16,13) = D(1:16,13) + X(15,13) * A(1:16,15)
    D(1:16,14) = D(1:16,14) + X(15,14) * A(1:16,15)

    D(1:16,1) = D(1:16,1) + X(16,1) * A(1:16,16)
    D(1:16,2) = D(1:16,2) + X(16,2) * A(1:16,16)
    D(1:16,3) = D(1:16,3) + X(16,3) * A(1:16,16)
    D(1:16,4) = D(1:16,4) + X(16,4) * A(1:16,16)
    D(1:16,5) = D(1:16,5) + X(16,5) * A(1:16,16)
    D(1:16,6) = D(1:16,6) + X(16,6) * A(1:16,16)
    D(1:16,7) = D(1:16,7) + X(16,7) * A(1:16,16)
    D(1:16,8) = D(1:16,8) + X(16,8) * A(1:16,16)
    D(1:16,9) = D(1:16,9) + X(16,9) * A(1:16,16)
    D(1:16,10) = D(1:16,10) + X(16,10) * A(1:16,16)
    D(1:16,11) = D(1:16,11) + X(16,11) * A(1:16,16)
    D(1:16,12) = D(1:16,12) + X(16,12) * A(1:16,16)
    D(1:16,13) = D(1:16,13) + X(16,13) * A(1:16,16)
    D(1:16,14) = D(1:16,14) + X(16,14) * A(1:16,16)

    D(1:16,1) = D(1:16,1) + X(17,1) * A(1:16,17)
    D(1:16,2) = D(1:16,2) + X(17,2) * A(1:16,17)
    D(1:16,3) = D(1:16,3) + X(17,3) * A(1:16,17)
    D(1:16,4) = D(1:16,4) + X(17,4) * A(1:16,17)
    D(1:16,5) = D(1:16,5) + X(17,5) * A(1:16,17)
    D(1:16,6) = D(1:16,6) + X(17,6) * A(1:16,17)
    D(1:16,7) = D(1:16,7) + X(17,7) * A(1:16,17)
    D(1:16,8) = D(1:16,8) + X(17,8) * A(1:16,17)
    D(1:16,9) = D(1:16,9) + X(17,9) * A(1:16,17)
    D(1:16,10) = D(1:16,10) + X(17,10) * A(1:16,17)
    D(1:16,11) = D(1:16,11) + X(17,11) * A(1:16,17)
    D(1:16,12) = D(1:16,12) + X(17,12) * A(1:16,17)
    D(1:16,13) = D(1:16,13) + X(17,13) * A(1:16,17)
    D(1:16,14) = D(1:16,14) + X(17,14) * A(1:16,17)

    D(1:16,1) = D(1:16,1) + X(18,1) * A(1:16,18)
    D(1:16,2) = D(1:16,2) + X(18,2) * A(1:16,18)
    D(1:16,3) = D(1:16,3) + X(18,3) * A(1:16,18)
    D(1:16,4) = D(1:16,4) + X(18,4) * A(1:16,18)
    D(1:16,5) = D(1:16,5) + X(18,5) * A(1:16,18)
    D(1:16,6) = D(1:16,6) + X(18,6) * A(1:16,18)
    D(1:16,7) = D(1:16,7) + X(18,7) * A(1:16,18)
    D(1:16,8) = D(1:16,8) + X(18,8) * A(1:16,18)
    D(1:16,9) = D(1:16,9) + X(18,9) * A(1:16,18)
    D(1:16,10) = D(1:16,10) + X(18,10) * A(1:16,18)
    D(1:16,11) = D(1:16,11) + X(18,11) * A(1:16,18)
    D(1:16,12) = D(1:16,12) + X(18,12) * A(1:16,18)
    D(1:16,13) = D(1:16,13) + X(18,13) * A(1:16,18)
    D(1:16,14) = D(1:16,14) + X(18,14) * A(1:16,18)

    D(1:16,1) = D(1:16,1) + X(19,1) * A(1:16,19)
    D(1:16,2) = D(1:16,2) + X(19,2) * A(1:16,19)
    D(1:16,3) = D(1:16,3) + X(19,3) * A(1:16,19)
    D(1:16,4) = D(1:16,4) + X(19,4) * A(1:16,19)
    D(1:16,5) = D(1:16,5) + X(19,5) * A(1:16,19)
    D(1:16,6) = D(1:16,6) + X(19,6) * A(1:16,19)
    D(1:16,7) = D(1:16,7) + X(19,7) * A(1:16,19)
    D(1:16,8) = D(1:16,8) + X(19,8) * A(1:16,19)
    D(1:16,9) = D(1:16,9) + X(19,9) * A(1:16,19)
    D(1:16,10) = D(1:16,10) + X(19,10) * A(1:16,19)
    D(1:16,11) = D(1:16,11) + X(19,11) * A(1:16,19)
    D(1:16,12) = D(1:16,12) + X(19,12) * A(1:16,19)
    D(1:16,13) = D(1:16,13) + X(19,13) * A(1:16,19)
    D(1:16,14) = D(1:16,14) + X(19,14) * A(1:16,19)

    D(1:16,1) = D(1:16,1) + X(20,1) * A(1:16,20)
    D(1:16,2) = D(1:16,2) + X(20,2) * A(1:16,20)
    D(1:16,3) = D(1:16,3) + X(20,3) * A(1:16,20)
    D(1:16,4) = D(1:16,4) + X(20,4) * A(1:16,20)
    D(1:16,5) = D(1:16,5) + X(20,5) * A(1:16,20)
    D(1:16,6) = D(1:16,6) + X(20,6) * A(1:16,20)
    D(1:16,7) = D(1:16,7) + X(20,7) * A(1:16,20)
    D(1:16,8) = D(1:16,8) + X(20,8) * A(1:16,20)
    D(1:16,9) = D(1:16,9) + X(20,9) * A(1:16,20)
    D(1:16,10) = D(1:16,10) + X(20,10) * A(1:16,20)
    D(1:16,11) = D(1:16,11) + X(20,11) * A(1:16,20)
    D(1:16,12) = D(1:16,12) + X(20,12) * A(1:16,20)
    D(1:16,13) = D(1:16,13) + X(20,13) * A(1:16,20)
    D(1:16,14) = D(1:16,14) + X(20,14) * A(1:16,20)

    D(1:16,1) = D(1:16,1) + X(21,1) * A(1:16,21)
    D(1:16,2) = D(1:16,2) + X(21,2) * A(1:16,21)
    D(1:16,3) = D(1:16,3) + X(21,3) * A(1:16,21)
    D(1:16,4) = D(1:16,4) + X(21,4) * A(1:16,21)
    D(1:16,5) = D(1:16,5) + X(21,5) * A(1:16,21)
    D(1:16,6) = D(1:16,6) + X(21,6) * A(1:16,21)
    D(1:16,7) = D(1:16,7) + X(21,7) * A(1:16,21)
    D(1:16,8) = D(1:16,8) + X(21,8) * A(1:16,21)
    D(1:16,9) = D(1:16,9) + X(21,9) * A(1:16,21)
    D(1:16,10) = D(1:16,10) + X(21,10) * A(1:16,21)
    D(1:16,11) = D(1:16,11) + X(21,11) * A(1:16,21)
    D(1:16,12) = D(1:16,12) + X(21,12) * A(1:16,21)
    D(1:16,13) = D(1:16,13) + X(21,13) * A(1:16,21)
    D(1:16,14) = D(1:16,14) + X(21,14) * A(1:16,21)

    D(1:16,1) = D(1:16,1) + X(22,1) * A(1:16,22)
    D(1:16,2) = D(1:16,2) + X(22,2) * A(1:16,22)
    D(1:16,3) = D(1:16,3) + X(22,3) * A(1:16,22)
    D(1:16,4) = D(1:16,4) + X(22,4) * A(1:16,22)
    D(1:16,5) = D(1:16,5) + X(22,5) * A(1:16,22)
    D(1:16,6) = D(1:16,6) + X(22,6) * A(1:16,22)
    D(1:16,7) = D(1:16,7) + X(22,7) * A(1:16,22)
    D(1:16,8) = D(1:16,8) + X(22,8) * A(1:16,22)
    D(1:16,9) = D(1:16,9) + X(22,9) * A(1:16,22)
    D(1:16,10) = D(1:16,10) + X(22,10) * A(1:16,22)
    D(1:16,11) = D(1:16,11) + X(22,11) * A(1:16,22)
    D(1:16,12) = D(1:16,12) + X(22,12) * A(1:16,22)
    D(1:16,13) = D(1:16,13) + X(22,13) * A(1:16,22)
    D(1:16,14) = D(1:16,14) + X(22,14) * A(1:16,22)

    D(1:16,1) = D(1:16,1) + X(23,1) * A(1:16,23)
    D(1:16,2) = D(1:16,2) + X(23,2) * A(1:16,23)
    D(1:16,3) = D(1:16,3) + X(23,3) * A(1:16,23)
    D(1:16,4) = D(1:16,4) + X(23,4) * A(1:16,23)
    D(1:16,5) = D(1:16,5) + X(23,5) * A(1:16,23)
    D(1:16,6) = D(1:16,6) + X(23,6) * A(1:16,23)
    D(1:16,7) = D(1:16,7) + X(23,7) * A(1:16,23)
    D(1:16,8) = D(1:16,8) + X(23,8) * A(1:16,23)
    D(1:16,9) = D(1:16,9) + X(23,9) * A(1:16,23)
    D(1:16,10) = D(1:16,10) + X(23,10) * A(1:16,23)
    D(1:16,11) = D(1:16,11) + X(23,11) * A(1:16,23)
    D(1:16,12) = D(1:16,12) + X(23,12) * A(1:16,23)
    D(1:16,13) = D(1:16,13) + X(23,13) * A(1:16,23)
    D(1:16,14) = D(1:16,14) + X(23,14) * A(1:16,23)

    D(1:16,1) = D(1:16,1) + X(24,1) * A(1:16,24)
    D(1:16,2) = D(1:16,2) + X(24,2) * A(1:16,24)
    D(1:16,3) = D(1:16,3) + X(24,3) * A(1:16,24)
    D(1:16,4) = D(1:16,4) + X(24,4) * A(1:16,24)
    D(1:16,5) = D(1:16,5) + X(24,5) * A(1:16,24)
    D(1:16,6) = D(1:16,6) + X(24,6) * A(1:16,24)
    D(1:16,7) = D(1:16,7) + X(24,7) * A(1:16,24)
    D(1:16,8) = D(1:16,8) + X(24,8) * A(1:16,24)
    D(1:16,9) = D(1:16,9) + X(24,9) * A(1:16,24)
    D(1:16,10) = D(1:16,10) + X(24,10) * A(1:16,24)
    D(1:16,11) = D(1:16,11) + X(24,11) * A(1:16,24)
    D(1:16,12) = D(1:16,12) + X(24,12) * A(1:16,24)
    D(1:16,13) = D(1:16,13) + X(24,13) * A(1:16,24)
    D(1:16,14) = D(1:16,14) + X(24,14) * A(1:16,24)

    D(1:16,1) = D(1:16,1) + X(25,1) * A(1:16,25)
    D(1:16,2) = D(1:16,2) + X(25,2) * A(1:16,25)
    D(1:16,3) = D(1:16,3) + X(25,3) * A(1:16,25)
    D(1:16,4) = D(1:16,4) + X(25,4) * A(1:16,25)
    D(1:16,5) = D(1:16,5) + X(25,5) * A(1:16,25)
    D(1:16,6) = D(1:16,6) + X(25,6) * A(1:16,25)
    D(1:16,7) = D(1:16,7) + X(25,7) * A(1:16,25)
    D(1:16,8) = D(1:16,8) + X(25,8) * A(1:16,25)
    D(1:16,9) = D(1:16,9) + X(25,9) * A(1:16,25)
    D(1:16,10) = D(1:16,10) + X(25,10) * A(1:16,25)
    D(1:16,11) = D(1:16,11) + X(25,11) * A(1:16,25)
    D(1:16,12) = D(1:16,12) + X(25,12) * A(1:16,25)
    D(1:16,13) = D(1:16,13) + X(25,13) * A(1:16,25)
    D(1:16,14) = D(1:16,14) + X(25,14) * A(1:16,25)

    D(1:16,1) = D(1:16,1) + X(26,1) * A(1:16,26)
    D(1:16,2) = D(1:16,2) + X(26,2) * A(1:16,26)
    D(1:16,3) = D(1:16,3) + X(26,3) * A(1:16,26)
    D(1:16,4) = D(1:16,4) + X(26,4) * A(1:16,26)
    D(1:16,5) = D(1:16,5) + X(26,5) * A(1:16,26)
    D(1:16,6) = D(1:16,6) + X(26,6) * A(1:16,26)
    D(1:16,7) = D(1:16,7) + X(26,7) * A(1:16,26)
    D(1:16,8) = D(1:16,8) + X(26,8) * A(1:16,26)
    D(1:16,9) = D(1:16,9) + X(26,9) * A(1:16,26)
    D(1:16,10) = D(1:16,10) + X(26,10) * A(1:16,26)
    D(1:16,11) = D(1:16,11) + X(26,11) * A(1:16,26)
    D(1:16,12) = D(1:16,12) + X(26,12) * A(1:16,26)
    D(1:16,13) = D(1:16,13) + X(26,13) * A(1:16,26)
    D(1:16,14) = D(1:16,14) + X(26,14) * A(1:16,26)

    D(1:16,1) = D(1:16,1) + X(27,1) * A(1:16,27)
    D(1:16,2) = D(1:16,2) + X(27,2) * A(1:16,27)
    D(1:16,3) = D(1:16,3) + X(27,3) * A(1:16,27)
    D(1:16,4) = D(1:16,4) + X(27,4) * A(1:16,27)
    D(1:16,5) = D(1:16,5) + X(27,5) * A(1:16,27)
    D(1:16,6) = D(1:16,6) + X(27,6) * A(1:16,27)
    D(1:16,7) = D(1:16,7) + X(27,7) * A(1:16,27)
    D(1:16,8) = D(1:16,8) + X(27,8) * A(1:16,27)
    D(1:16,9) = D(1:16,9) + X(27,9) * A(1:16,27)
    D(1:16,10) = D(1:16,10) + X(27,10) * A(1:16,27)
    D(1:16,11) = D(1:16,11) + X(27,11) * A(1:16,27)
    D(1:16,12) = D(1:16,12) + X(27,12) * A(1:16,27)
    D(1:16,13) = D(1:16,13) + X(27,13) * A(1:16,27)
    D(1:16,14) = D(1:16,14) + X(27,14) * A(1:16,27)

    D(1:16,1) = D(1:16,1) + X(28,1) * A(1:16,28)
    D(1:16,2) = D(1:16,2) + X(28,2) * A(1:16,28)
    D(1:16,3) = D(1:16,3) + X(28,3) * A(1:16,28)
    D(1:16,4) = D(1:16,4) + X(28,4) * A(1:16,28)
    D(1:16,5) = D(1:16,5) + X(28,5) * A(1:16,28)
    D(1:16,6) = D(1:16,6) + X(28,6) * A(1:16,28)
    D(1:16,7) = D(1:16,7) + X(28,7) * A(1:16,28)
    D(1:16,8) = D(1:16,8) + X(28,8) * A(1:16,28)
    D(1:16,9) = D(1:16,9) + X(28,9) * A(1:16,28)
    D(1:16,10) = D(1:16,10) + X(28,10) * A(1:16,28)
    D(1:16,11) = D(1:16,11) + X(28,11) * A(1:16,28)
    D(1:16,12) = D(1:16,12) + X(28,12) * A(1:16,28)
    D(1:16,13) = D(1:16,13) + X(28,13) * A(1:16,28)
    D(1:16,14) = D(1:16,14) + X(28,14) * A(1:16,28)

    D(1:16,1) = D(1:16,1) + X(29,1) * A(1:16,29)
    D(1:16,2) = D(1:16,2) + X(29,2) * A(1:16,29)
    D(1:16,3) = D(1:16,3) + X(29,3) * A(1:16,29)
    D(1:16,4) = D(1:16,4) + X(29,4) * A(1:16,29)
    D(1:16,5) = D(1:16,5) + X(29,5) * A(1:16,29)
    D(1:16,6) = D(1:16,6) + X(29,6) * A(1:16,29)
    D(1:16,7) = D(1:16,7) + X(29,7) * A(1:16,29)
    D(1:16,8) = D(1:16,8) + X(29,8) * A(1:16,29)
    D(1:16,9) = D(1:16,9) + X(29,9) * A(1:16,29)
    D(1:16,10) = D(1:16,10) + X(29,10) * A(1:16,29)
    D(1:16,11) = D(1:16,11) + X(29,11) * A(1:16,29)
    D(1:16,12) = D(1:16,12) + X(29,12) * A(1:16,29)
    D(1:16,13) = D(1:16,13) + X(29,13) * A(1:16,29)
    D(1:16,14) = D(1:16,14) + X(29,14) * A(1:16,29)

    D(1:16,1) = D(1:16,1) + X(30,1) * A(1:16,30)
    D(1:16,2) = D(1:16,2) + X(30,2) * A(1:16,30)
    D(1:16,3) = D(1:16,3) + X(30,3) * A(1:16,30)
    D(1:16,4) = D(1:16,4) + X(30,4) * A(1:16,30)
    D(1:16,5) = D(1:16,5) + X(30,5) * A(1:16,30)
    D(1:16,6) = D(1:16,6) + X(30,6) * A(1:16,30)
    D(1:16,7) = D(1:16,7) + X(30,7) * A(1:16,30)
    D(1:16,8) = D(1:16,8) + X(30,8) * A(1:16,30)
    D(1:16,9) = D(1:16,9) + X(30,9) * A(1:16,30)
    D(1:16,10) = D(1:16,10) + X(30,10) * A(1:16,30)
    D(1:16,11) = D(1:16,11) + X(30,11) * A(1:16,30)
    D(1:16,12) = D(1:16,12) + X(30,12) * A(1:16,30)
    D(1:16,13) = D(1:16,13) + X(30,13) * A(1:16,30)
    D(1:16,14) = D(1:16,14) + X(30,14) * A(1:16,30)

    D(1:16,1) = D(1:16,1) + X(31,1) * A(1:16,31)
    D(1:16,2) = D(1:16,2) + X(31,2) * A(1:16,31)
    D(1:16,3) = D(1:16,3) + X(31,3) * A(1:16,31)
    D(1:16,4) = D(1:16,4) + X(31,4) * A(1:16,31)
    D(1:16,5) = D(1:16,5) + X(31,5) * A(1:16,31)
    D(1:16,6) = D(1:16,6) + X(31,6) * A(1:16,31)
    D(1:16,7) = D(1:16,7) + X(31,7) * A(1:16,31)
    D(1:16,8) = D(1:16,8) + X(31,8) * A(1:16,31)
    D(1:16,9) = D(1:16,9) + X(31,9) * A(1:16,31)
    D(1:16,10) = D(1:16,10) + X(31,10) * A(1:16,31)
    D(1:16,11) = D(1:16,11) + X(31,11) * A(1:16,31)
    D(1:16,12) = D(1:16,12) + X(31,12) * A(1:16,31)
    D(1:16,13) = D(1:16,13) + X(31,13) * A(1:16,31)
    D(1:16,14) = D(1:16,14) + X(31,14) * A(1:16,31)

    D(1:16,1) = D(1:16,1) + X(32,1) * A(1:16,32)
    D(1:16,2) = D(1:16,2) + X(32,2) * A(1:16,32)
    D(1:16,3) = D(1:16,3) + X(32,3) * A(1:16,32)
    D(1:16,4) = D(1:16,4) + X(32,4) * A(1:16,32)
    D(1:16,5) = D(1:16,5) + X(32,5) * A(1:16,32)
    D(1:16,6) = D(1:16,6) + X(32,6) * A(1:16,32)
    D(1:16,7) = D(1:16,7) + X(32,7) * A(1:16,32)
    D(1:16,8) = D(1:16,8) + X(32,8) * A(1:16,32)
    D(1:16,9) = D(1:16,9) + X(32,9) * A(1:16,32)
    D(1:16,10) = D(1:16,10) + X(32,10) * A(1:16,32)
    D(1:16,11) = D(1:16,11) + X(32,11) * A(1:16,32)
    D(1:16,12) = D(1:16,12) + X(32,12) * A(1:16,32)
    D(1:16,13) = D(1:16,13) + X(32,13) * A(1:16,32)
    D(1:16,14) = D(1:16,14) + X(32,14) * A(1:16,32)

end subroutine mulkernel

end module kernels