1C> \ingroup nwad_tests
2C> @{
3C>
4C> \brief test the implementation of the TANH function
5C>
6C> This is an NWAD unit test for the multivariate implementation.
7C> The derivatives of TANH function are compared
8C> against analytic derivatives. The function is 3-dimensional as that is
9C> sufficient for this test. The input data set is randomly generated.
10C>
11      program test_tanh_m3
12      use nwad3
13      implicit none
14      integer :: npt, i, mmvar
15      integer :: i1, i2, i3
16      integer :: ix, ix2, ix3
17      parameter (mmvar = 3)
18      parameter (npt = 100)
19      integer :: iv(mmvar)
20      integer :: numvar
21      type(nwad_dble) :: x, y, z, f
22      double precision fa,dfa(mmvar),dfa2(mmvar*(mmvar+1)/2)
23      double precision dfa3(mmvar*(mmvar+1)*(mmvar+2)/6), tol
24      double precision tmp(3), tf, df
25      parameter( tol = 1.0d-10)
26      call random_seed
27      do i = 1, npt
28        call random_number(tmp)
29        tmp = tmp*2.0d0*acos(-1.0d0)
30        x = set_gamma_aa(tmp(1))
31        y = set_gamma_ab(tmp(2))
32        z = set_gamma_bb(tmp(3))
33        call submaxima_tanh3(x%d0,y%d0,z%d0,fa,dfa,dfa2,dfa3)
34        call subad_tanh3(x,y,z,f)
35        if (abs((fa-f%d0)/(fa+f%d0)).gt.tol) then
36          write(*,*)"F  : fail:",i,x%d0,y%d0,z%d0,fa
37          write(*,*)"F  : fail:",i,x%d0,y%d0,z%d0,f%d0
38          write(*,*)
39        endif
40        numvar = get_nvar(f)
41        do i1 = 1, numvar
42          call get_d1(f,i1,tf,iv(i1))
43          if (abs((dfa(i1)-tf)/(dfa(i1)+tf)).gt.tol) then
44            write(*,10)i,i1,x%d0,y%d0,z%d0,dfa(i)
45            write(*,10)i,i1,x%d0,y%d0,z%d0,tf
46            write(*,*)
47          endif
48        enddo
49        do i1 = 1, numvar
50          do i2 = 1, i1
51            call get_d2(f,i1,i2,tf,iv(i1),iv(i2))
52            df = dfa2(i1*(i1-1)/2+i2)
53            if (abs((df-tf)/(df+tf)).gt.tol) then
54              write(*,20)i,i1,i2,x%d0,y%d0,z%d0,df
55              write(*,20)i,i1,i2,x%d0,y%d0,z%d0,tf
56              write(*,*)
57            endif
58          enddo
59        enddo
60        do i1 = 1, numvar
61          do i2 = 1, i1
62            do i3 = 1, i2
63              call get_d3(f,i1,i2,i3,tf,iv(i1),iv(i2),iv(i3))
64              df = dfa3((i1+1)*i1*(i1-1)/6+i2*(i2-1)/2+i3)
65              if (abs((df-tf)/(df+tf)).gt.tol) then
66                write(*,30)i,i1,i2,i3,x%d0,y%d0,z%d0,df
67                write(*,30)i,i1,i2,i3,x%d0,y%d0,z%d0,tf
68                write(*,*)
69              endif
70            enddo
71          enddo
72        enddo
73      enddo
74 10   format("DF : fail:",i4, i2,3e10.3,e18.10)
75 20   format("DF2: fail:",i4,2i2,3e10.3,e18.10)
76 30   format("DF3: fail:",i4,3i2,3e10.3,e18.10)
77      end
78C>
79C> \brief The test routine
80C>
81      subroutine subad_tanh3(x,y,z,f)
82      use nwad3
83      implicit none
84      type(nwad_dble) :: x, y, z, t, f
85      t = 2.0d0/3.0d0*(sin(x) + sin(y) + sin(z))
86      f = tanh(t)
87      end
88C> @}
89c $Id: test_add.F 26056 2014-08-26 19:03:07Z d3y133 $
90