xref: /libCEED/tests/t200-elemrestriction-f.f90 (revision 8a4ce0d78b95fffc485d7f6e76eabd31204930a1)
1!-----------------------------------------------------------------------
2      program test
3      implicit none
4      include 'ceedf.h'
5
6      integer ceed,err
7      integer x,y
8      integer r
9      integer i
10      integer*8 aoffset,yoffset
11
12      integer ne
13      parameter(ne=3)
14
15      integer*4 ind(2*ne)
16      real*8 a(ne+1)
17      real*8 yy(2*ne)
18      real*8 diff
19
20      character arg*32
21
22      call getarg(1,arg)
23      call ceedinit(trim(arg)//char(0),ceed,err)
24
25      call ceedvectorcreate(ceed,ne+1,x,err)
26
27      do i=1,ne+1
28        a(i)=10+i-1
29      enddo
30
31      aoffset=0
32      call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err)
33
34      do i=1,ne
35        ind(2*i-1)=i-1
36        ind(2*i  )=i
37      enddo
38
39      call ceedelemrestrictioncreate(ceed,ne,2,1,1,ne+1,ceed_mem_host,&
40     & ceed_use_pointer,ind,r,err)
41
42      call ceedvectorcreate(ceed,2*ne,y,err);
43      call ceedvectorsetvalue(y,0.d0,err);
44      call ceedelemrestrictionapply(r,ceed_notranspose,x,y,&
45     & ceed_request_immediate,err)
46
47      call ceedvectorgetarrayread(y,ceed_mem_host,yy,yoffset,err)
48      do i=1,ne*2
49        diff=10+i/2-yy(i+yoffset)
50        if (abs(diff) > 1.0D-15) then
51! LCOV_EXCL_START
52          write(*,*) 'Error in restricted array y(',i,')=',yy(i+yoffset)
53! LCOV_EXCL_STOP
54        endif
55      enddo
56      call ceedvectorrestorearrayread(y,yy,yoffset,err)
57
58      call ceedvectordestroy(x,err)
59      call ceedvectordestroy(y,err)
60      call ceedelemrestrictiondestroy(r,err)
61      call ceeddestroy(ceed,err)
62
63      end
64!-----------------------------------------------------------------------
65