!!-*- mode:f90 -*-
!! Template for build-more-tests.awk
!! Notes:
!! <sca>, <vec> and <mat> lines are repeated for all scalar, vector and
!!   matrix parameters specified in test-more-param.txt
!! <scamat> lines are repeated for scalars and matrices
!! <scaa>, <veca> and <mata> are repeated for corresponding adjoints
!! <par> lines are repeated for all parameters (sca, vec and mat) 
!! <para> lines are repeated for all adjoints
!! <upd> lines are repeated for all += adjoints
!! <opt> lines are repeated for all options (side, trans, uplo, diag)
!! <inc> lines are repeated for vector-increments
!! <vec1> is replaced with the first char of <vec> (to make e.g. incx)
!! <OPER> <call> and <j> are replaced appropriately
!! update: in test-more-param.txt specifes adjoints that are "added to"
!!
PROGRAM TEST_MORE_<OPER>
  implicit none
  integer, parameter :: n = 4! n must be >= 1 + 2*bandwidth
  integer, parameter :: nsel = <nsel_array>, nsels = <nsel_scalar>
  real :: <sca>
  real :: <wrk>(n)
  real :: <wrks>(n)
  real :: <mat>(n,n)
  real :: <pck>(n*(n+1)/2)
  real :: <scaa>0, <scaa>13
  real :: <mata>0(n,n), <mata>13(n,n)
  real :: <pcka>0(n*(n+1)/2), <pcka>13(n*(n+1)/2)
  real, allocatable :: <vec>(:)
  real, allocatable :: <veca>0(:)
  real, allocatable :: <veca>13(:)
  character :: <ctrl>
  integer   :: isel
  character :: fmt*6, ones*5 = '11111'
  character :: sel*(nsel), sels*(nsels), selall*(nsel + nsels)
  integer   :: i<opt>
  character :: <opt>
  integer :: inc<inc>
  character(*), parameter :: routine = '<oper>_rmd'
  character(*), parameter :: <opt>s = '<optlist>'
  character(*), parameter :: testtype(0:5) = [character(100) :: &
    & 'Unknown', &
    & '(a) check that all arrays retained from blas call are unchanged',&
    & '(b) that added-to adjoints are indeed added to',&
    & '(c) that selected adjoints are the same as when all adjoints are selected',&
    & '(d) that not selected adjoints remain unchanged',&
    & '(e) that places inbetween incx positions remain unchanged']
  ! suppress unused subroutine/function warnings:
  sel = ones(1:<nsel_array>)
  sels = ones(1:<nsel_scalar>)
  call assert(almostequal(0.0, 0.0), '', '')
  ! Run for all combinations of trans_, uplo, diag and/or side
  do i<opt> = 1,2
    do inc<inc> = 1,2
      allocate(<vec>(n*inc<vec1>))
      allocate(<veca>0(n*inc<vec1>))
      allocate(<veca>13(n*inc<vec1>))
      <opt> = <opt>s(i<opt>:i<opt>)
      ! Check (a):
      <pard> = 7.0
      <para> = 0.0
      <veca>0 = 0.0
      <callrmds>
      <callrmd>
      <para>0 = <para>
      !! e.g. call sdotn_rmd(n, x, 1, y, 1, dot, xi0, yi0, sel)
      call assert(<all>(almostequal(<par>, 7.0)), '(a)', '<par>')
      ! Check (b)
      <upd> = 13.0
      <callrmds>
      <callrmd>
      call assert(<all>(almostequal(<upd><inc1>, <upd>0<inc1> + 13.0)), '(b)','<upd>')
      !! Check (e) for all vectors
      if (inc<vec1> > 1) then;  <vec> = 13.0;  <callrmd>;  call assert(<all>(almostequal(<vec><inc2>, 13.0)), '(e)','<vec>');endif
      !! Run for all possible selection combinations:
      ! check (c), (d) and (e):
      <par> = 7.0
      do isel = 1, 2**(nsel + nsels) - 1
        sel = ones(1:nsel)
        sels = ones(1:nsels)
        <para> = 13.0
        <callrmds>
        <callrmd>
        <para>13 = <para>
        write(fmt, '("(B",i1,".",i1,")")') nsel+nsels,nsel+nsels ! e.g. '(B5.5)'
        write(selall, fmt) isel-1 ! e.g. '00110' for isel-1 = 6
        sel = selall(1:nsel)
        sels = selall(nsel+1:nsel+nsels)
        <sel> = 13.0
        <sels> = 13.0
        <wrk> = 37.0
        <callrmds>
        <callrmd>
        call assert(<all>(almostequal(<par>,7.0)), '(a)', '<par>')
        if (sel(<j>:<j>) == '1') call assert(<all>(almostequal(<sel><inc1>,<sel>13<inc1>)), '(c)', '<sel>')
        if (sel(<j>:<j>) == '0') call assert(<all>(almostequal(<sel><inc1>,13.0)), '(d)', '<sel>')
        if (sels(<j>:<j>) == '1') call assert(<all>(almostequal(<sels>,<sels>13)), '(c)', '<sels>')
        if (sels(<j>:<j>) == '0') call assert(<all>(almostequal(<sels>,13.0)), '(d)', '<sels>')
        if (sel(<wrksel>:<wrksel>) == '1') call assert(<all>(almostequal(<wrk>,37.0)), '(e)', '<wrk>')
      enddo
      deallocate(<veca>13)
      deallocate(<veca>0)
      deallocate(<vec>)
    enddo !inc<inc>
  enddo !i<opt>
CONTAINS
subroutine assert(s, test, par)
  logical, intent(in) :: s
  character(*), intent(in) :: test, par
  integer i, k
  character(*), parameter :: fmt = '(A,T11,"= ",A)'
  if (.not. s) then
    k = 0
    do i=1,ubound(testtype,1)
      if (testtype(i)(1:3) == test) k=i
      enddo
      print *
      print '(A)', 'TEST_MORE: Assertion failed'
      print fmt, 'routine', routine
      print fmt, 'test', trim(testtype(k))
      print fmt, 'call', '<callrmd>'
      print fmt, 'parameter', par
      print fmt, 'sel', '"'//sel//'"'
      print fmt, 'sels', '"'//sels//'"'
      print fmt, '<opt>', <opt>
      stop 1
    endif
  end subroutine assert
  elemental function almostequal(x,y) result(ameq)
    real, intent(in) :: x, y
    logical ameq
    real, parameter :: delta = epsilon(0.0)**(2.0/3)
    ameq = abs(x-y) < delta
  end function almostequal

END PROGRAM TEST_MORE_<OPER>
