xref: /libCEED/tests/t101-vector-f.f90 (revision 0436c2ad4dd95c9ccd89f5346568014600de10a7)
1*0436c2adSjeremylt!-----------------------------------------------------------------------
2*0436c2adSjeremylt      program test
3*0436c2adSjeremylt
4*0436c2adSjeremylt      include 'ceedf.h'
5*0436c2adSjeremylt
6*0436c2adSjeremylt      integer ceed,err
7*0436c2adSjeremylt      integer x,n
8*0436c2adSjeremylt      real*8 a(10)
9*0436c2adSjeremylt      real*8 b(10)
10*0436c2adSjeremylt      real*8 diff
11*0436c2adSjeremylt      real*8 val
12*0436c2adSjeremylt      integer*8 aoffset,boffset
13*0436c2adSjeremylt      character arg*32
14*0436c2adSjeremylt
15*0436c2adSjeremylt      call getarg(1,arg)
16*0436c2adSjeremylt
17*0436c2adSjeremylt      call ceedinit(trim(arg)//char(0),ceed,err)
18*0436c2adSjeremylt
19*0436c2adSjeremylt      n=10
20*0436c2adSjeremylt      val=3.0
21*0436c2adSjeremylt
22*0436c2adSjeremylt      call ceedvectorcreate(ceed,n,x,err)
23*0436c2adSjeremylt
24*0436c2adSjeremylt      do i=1,10
25*0436c2adSjeremylt        a(i)=10+i
26*0436c2adSjeremylt      enddo
27*0436c2adSjeremylt
28*0436c2adSjeremylt      aoffset=0
29*0436c2adSjeremylt      call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err)
30*0436c2adSjeremylt      call ceedvectorgetarrayread(x,ceed_mem_host,b,boffset,err)
31*0436c2adSjeremylt
32*0436c2adSjeremylt      do i=1,10
33*0436c2adSjeremylt        diff=b(boffset+i)-10-i
34*0436c2adSjeremylt        if (abs(diff)>1.0D-15) then
35*0436c2adSjeremylt! LCOV_EXCL_START
36*0436c2adSjeremylt          write(*,*) 'Error reading array b(',i,')=',b(boffset+i)
37*0436c2adSjeremylt! LCOV_EXCL_STOP
38*0436c2adSjeremylt        endif
39*0436c2adSjeremylt      enddo
40*0436c2adSjeremylt
41*0436c2adSjeremylt      call ceedvectorrestorearrayread(x,b,boffset,err)
42*0436c2adSjeremylt
43*0436c2adSjeremylt      call ceedvectorsetvalue(x,val,err)
44*0436c2adSjeremylt      call ceedvectorgetarrayread(x,ceed_mem_host,b,boffset,err)
45*0436c2adSjeremylt
46*0436c2adSjeremylt      do i=1,10
47*0436c2adSjeremylt        diff=b(boffset+i)-val
48*0436c2adSjeremylt        if (abs(diff)>1.0D-15) then
49*0436c2adSjeremylt! LCOV_EXCL_START
50*0436c2adSjeremylt          write(*,*) 'Error reading array b(',i,')=',b(boffset+i)
51*0436c2adSjeremylt! LCOV_EXCL_STOP
52*0436c2adSjeremylt        endif
53*0436c2adSjeremylt      enddo
54*0436c2adSjeremylt
55*0436c2adSjeremylt      call ceedvectorrestorearrayread(x,b,boffset,err)
56*0436c2adSjeremylt
57*0436c2adSjeremylt      call ceedvectordestroy(x,err)
58*0436c2adSjeremylt      call ceeddestroy(ceed,err)
59*0436c2adSjeremylt
60*0436c2adSjeremylt      end
61*0436c2adSjeremylt!-----------------------------------------------------------------------
62