xref: /libCEED/tests/t119-vector-f.f90 (revision d99fa3c5cd91a1690aedf0679cbf290d44fec74c)
1*d99fa3c5SJeremy L Thompson!-----------------------------------------------------------------------
2*d99fa3c5SJeremy L Thompson      program test
3*d99fa3c5SJeremy L Thompson      implicit none
4*d99fa3c5SJeremy L Thompson      include 'ceedf.h'
5*d99fa3c5SJeremy L Thompson
6*d99fa3c5SJeremy L Thompson      integer ceed,err
7*d99fa3c5SJeremy L Thompson      integer i,x,n
8*d99fa3c5SJeremy L Thompson      integer*8 aoffset,boffset
9*d99fa3c5SJeremy L Thompson      real*8 a(10)
10*d99fa3c5SJeremy L Thompson      real*8 b(10)
11*d99fa3c5SJeremy L Thompson      real*8 diff
12*d99fa3c5SJeremy L Thompson      character arg*32
13*d99fa3c5SJeremy L Thompson
14*d99fa3c5SJeremy L Thompson      call getarg(1,arg)
15*d99fa3c5SJeremy L Thompson
16*d99fa3c5SJeremy L Thompson      call ceedinit(trim(arg)//char(0),ceed,err)
17*d99fa3c5SJeremy L Thompson
18*d99fa3c5SJeremy L Thompson      n=10
19*d99fa3c5SJeremy L Thompson
20*d99fa3c5SJeremy L Thompson      call ceedvectorcreate(ceed,n,x,err)
21*d99fa3c5SJeremy L Thompson
22*d99fa3c5SJeremy L Thompson      do i=1,10
23*d99fa3c5SJeremy L Thompson        a(i)=10+i
24*d99fa3c5SJeremy L Thompson      enddo
25*d99fa3c5SJeremy L Thompson
26*d99fa3c5SJeremy L Thompson      aoffset=0
27*d99fa3c5SJeremy L Thompson      call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err)
28*d99fa3c5SJeremy L Thompson      call ceedvectorreciprocal(x,err)
29*d99fa3c5SJeremy L Thompson
30*d99fa3c5SJeremy L Thompson      call ceedvectorgetarrayread(x,ceed_mem_host,b,boffset,err)
31*d99fa3c5SJeremy L Thompson      do i=1,10
32*d99fa3c5SJeremy L Thompson        diff=1./(real(10+i,8))-b(i+boffset)
33*d99fa3c5SJeremy L Thompson        if (abs(diff)>1.0D-15) then
34*d99fa3c5SJeremy L Thompson! LCOV_EXCL_START
35*d99fa3c5SJeremy L Thompson          write(*,*) 'Error reading array b(',i,')=',b(i+boffset),diff
36*d99fa3c5SJeremy L Thompson! LCOV_EXCL_STOP
37*d99fa3c5SJeremy L Thompson        endif
38*d99fa3c5SJeremy L Thompson      enddo
39*d99fa3c5SJeremy L Thompson
40*d99fa3c5SJeremy L Thompson      call ceedvectorrestorearrayread(x,b,boffset,err)
41*d99fa3c5SJeremy L Thompson      call ceedvectordestroy(x,err)
42*d99fa3c5SJeremy L Thompson      call ceeddestroy(ceed,err)
43*d99fa3c5SJeremy L Thompson
44*d99fa3c5SJeremy L Thompson      end
45*d99fa3c5SJeremy L Thompson!-----------------------------------------------------------------------
46