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