xref: /libCEED/tests/t208-elemrestriction-f.f90 (revision 89c6efa49859cd40e0a2f99b4a91b922f3b4c9b2)
1!-----------------------------------------------------------------------
2      program test
3
4      include 'ceedf.h'
5
6      integer ceed,err
7      integer x,y
8      integer r
9
10      integer ne
11      parameter(ne=8)
12      integer blksize
13      parameter(blksize=5)
14
15      integer*4 ind(2*ne)
16      real*8 a(ne+1)
17      integer*8 aoffset
18
19      character arg*32
20
21      call getarg(1,arg)
22      call ceedinit(trim(arg)//char(0),ceed,err)
23
24      call ceedvectorcreate(ceed,ne+1,x,err)
25
26      do i=1,ne+1
27        a(i)=10+i-1
28      enddo
29
30      call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,err)
31
32      do i=1,ne
33        ind(2*i-1)=i-1
34        ind(2*i  )=i
35      enddo
36
37      call ceedelemrestrictioncreateblocked(ceed,ne,2,blksize,ne+1,1,&
38     & ceed_mem_host,ceed_use_pointer,ind,r,err)
39
40      call ceedvectorcreate(ceed,blksize*2,y,err);
41      call ceedvectorsetvalue(y,0.d0,err);
42
43!    No Transpose
44      call ceedelemrestrictionapplyblock(r,1,ceed_notranspose,ceed_notranspose,&
45     & x,y,ceed_request_immediate,err)
46      call ceedvectorview(y,err)
47
48!    Transpose
49      call ceedvectorgetarray(x,ceed_mem_host,a,aoffset,err)
50      do i=1,ne+1
51        a(aoffset+i)=0.0
52      enddo
53      call ceedvectorrestorearray(x,a,aoffset,err)
54
55      call ceedelemrestrictionapplyblock(r,1,ceed_transpose,ceed_notranspose,&
56     & y,x,ceed_request_immediate,err)
57
58      call ceedvectorview(x,err)
59
60      call ceedvectordestroy(x,err)
61      call ceedvectordestroy(y,err)
62      call ceedelemrestrictiondestroy(r,err)
63      call ceeddestroy(ceed,err)
64
65      end
66!-----------------------------------------------------------------------
67