xref: /libCEED/tests/t202-elemrestriction-f.f90 (revision a8d322087fa8f150327cdc2bf14a171452b711ec)
18980d4a7Sjeremylt!-----------------------------------------------------------------------
28980d4a7Sjeremylt      program test
38980d4a7Sjeremylt
48980d4a7Sjeremylt      include 'ceedf.h'
58980d4a7Sjeremylt
68980d4a7Sjeremylt      integer ceed,err
78980d4a7Sjeremylt      integer x,y
88980d4a7Sjeremylt      integer r
98980d4a7Sjeremylt
108980d4a7Sjeremylt      integer ne
118980d4a7Sjeremylt      parameter(ne=8)
12*a8d32208Sjeremylt      integer lmode
13*a8d32208Sjeremylt      parameter(lmode=ceed_notranspose)
148980d4a7Sjeremylt      integer blksize
158980d4a7Sjeremylt      parameter(blksize=5)
168980d4a7Sjeremylt
178980d4a7Sjeremylt      integer*4 ind(2*ne)
188980d4a7Sjeremylt      real*8 a(ne+1)
198980d4a7Sjeremylt      integer*8 aoffset
208980d4a7Sjeremylt
218980d4a7Sjeremylt      character arg*32
228980d4a7Sjeremylt
238980d4a7Sjeremylt      call getarg(1,arg)
248980d4a7Sjeremylt      call ceedinit(trim(arg)//char(0),ceed,err)
258980d4a7Sjeremylt
268980d4a7Sjeremylt      call ceedvectorcreate(ceed,ne+1,x,err)
278980d4a7Sjeremylt
288980d4a7Sjeremylt      do i=1,ne+1
298980d4a7Sjeremylt        a(i)=10+i-1
308980d4a7Sjeremylt      enddo
318980d4a7Sjeremylt
32c8b9fe72Sjeremylt      aoffset=0
33c8b9fe72Sjeremylt      call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err)
348980d4a7Sjeremylt
358980d4a7Sjeremylt      do i=1,ne
368980d4a7Sjeremylt        ind(2*i-1)=i-1
378980d4a7Sjeremylt        ind(2*i  )=i
388980d4a7Sjeremylt      enddo
398980d4a7Sjeremylt
40*a8d32208Sjeremylt      call ceedelemrestrictioncreateblocked(ceed,lmode,ne,2,blksize,ne+1,1,&
418980d4a7Sjeremylt     & ceed_mem_host,ceed_use_pointer,ind,r,err)
428980d4a7Sjeremylt
438980d4a7Sjeremylt      call ceedvectorcreate(ceed,2*blksize*2,y,err);
448980d4a7Sjeremylt      call ceedvectorsetvalue(y,0.d0,err);
458980d4a7Sjeremylt
468980d4a7Sjeremylt!    No Transpose
47*a8d32208Sjeremylt      call ceedelemrestrictionapply(r,ceed_notranspose,x,y,&
488980d4a7Sjeremylt     & ceed_request_immediate,err)
498980d4a7Sjeremylt      call ceedvectorview(y,err)
508980d4a7Sjeremylt
518980d4a7Sjeremylt!    Transpose
528980d4a7Sjeremylt      call ceedvectorgetarray(x,ceed_mem_host,a,aoffset,err)
538980d4a7Sjeremylt      do i=1,ne+1
548980d4a7Sjeremylt        a(aoffset+i)=0.0
558980d4a7Sjeremylt      enddo
568980d4a7Sjeremylt      call ceedvectorrestorearray(x,a,aoffset,err)
578980d4a7Sjeremylt
58*a8d32208Sjeremylt      call ceedelemrestrictionapply(r,ceed_transpose,y,x,&
598980d4a7Sjeremylt     & ceed_request_immediate,err)
608980d4a7Sjeremylt
618980d4a7Sjeremylt      call ceedvectorview(x,err)
628980d4a7Sjeremylt
638980d4a7Sjeremylt      call ceedvectordestroy(x,err)
648980d4a7Sjeremylt      call ceedvectordestroy(y,err)
658980d4a7Sjeremylt      call ceedelemrestrictiondestroy(r,err)
668980d4a7Sjeremylt      call ceeddestroy(ceed,err)
678980d4a7Sjeremylt
688980d4a7Sjeremylt      end
698980d4a7Sjeremylt!-----------------------------------------------------------------------
70