xref: /libCEED/tests/t208-elemrestriction-f.f90 (revision e1ef875599c3a6b02a7bf1f21ab905966273ff45)
1!-----------------------------------------------------------------------
2      program test
3      implicit none
4      include 'ceedf.h'
5
6      integer ceed,err
7      integer x,y
8      integer i,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      aoffset=0
31      call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err)
32
33      do i=1,ne
34        ind(2*i-1)=i-1
35        ind(2*i  )=i
36      enddo
37
38      call ceedelemrestrictioncreateblocked(ceed,ne,2,blksize,1,1,ne+1,&
39     & ceed_mem_host,ceed_use_pointer,ind,r,err)
40
41      call ceedvectorcreate(ceed,blksize*2,y,err);
42      call ceedvectorsetvalue(y,0.d0,err);
43
44!    No Transpose
45      call ceedelemrestrictionapplyblock(r,1,ceed_notranspose,&
46     & x,y,ceed_request_immediate,err)
47      call ceedvectorview(y,err)
48
49!    Transpose
50      call ceedvectorgetarray(x,ceed_mem_host,a,aoffset,err)
51      do i=1,ne+1
52        a(aoffset+i)=0.0
53      enddo
54      call ceedvectorrestorearray(x,a,aoffset,err)
55
56      call ceedelemrestrictionapplyblock(r,1,ceed_transpose,&
57     & y,x,ceed_request_immediate,err)
58
59      call ceedvectorview(x,err)
60
61      call ceedvectordestroy(x,err)
62      call ceedvectordestroy(y,err)
63      call ceedelemrestrictiondestroy(r,err)
64      call ceeddestroy(ceed,err)
65
66      end
67!-----------------------------------------------------------------------
68