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