xref: /libCEED/tests/t202-elemrestriction-f.f90 (revision c8b9fe725830f9f8c5d03a787223decb42394873)
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)
128980d4a7Sjeremylt      integer blksize
138980d4a7Sjeremylt      parameter(blksize=5)
148980d4a7Sjeremylt
158980d4a7Sjeremylt      integer*4 ind(2*ne)
168980d4a7Sjeremylt      real*8 a(ne+1)
178980d4a7Sjeremylt      integer*8 aoffset
188980d4a7Sjeremylt
198980d4a7Sjeremylt      character arg*32
208980d4a7Sjeremylt
218980d4a7Sjeremylt      call getarg(1,arg)
228980d4a7Sjeremylt      call ceedinit(trim(arg)//char(0),ceed,err)
238980d4a7Sjeremylt
248980d4a7Sjeremylt      call ceedvectorcreate(ceed,ne+1,x,err)
258980d4a7Sjeremylt
268980d4a7Sjeremylt      do i=1,ne+1
278980d4a7Sjeremylt        a(i)=10+i-1
288980d4a7Sjeremylt      enddo
298980d4a7Sjeremylt
30*c8b9fe72Sjeremylt      aoffset=0
31*c8b9fe72Sjeremylt      call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err)
328980d4a7Sjeremylt
338980d4a7Sjeremylt      do i=1,ne
348980d4a7Sjeremylt        ind(2*i-1)=i-1
358980d4a7Sjeremylt        ind(2*i  )=i
368980d4a7Sjeremylt      enddo
378980d4a7Sjeremylt
388980d4a7Sjeremylt      call ceedelemrestrictioncreateblocked(ceed,ne,2,blksize,ne+1,1,&
398980d4a7Sjeremylt     & ceed_mem_host,ceed_use_pointer,ind,r,err)
408980d4a7Sjeremylt
418980d4a7Sjeremylt      call ceedvectorcreate(ceed,2*blksize*2,y,err);
428980d4a7Sjeremylt      call ceedvectorsetvalue(y,0.d0,err);
438980d4a7Sjeremylt
448980d4a7Sjeremylt!    No Transpose
458980d4a7Sjeremylt      call ceedelemrestrictionapply(r,ceed_notranspose,ceed_notranspose,x,y,&
468980d4a7Sjeremylt     & ceed_request_immediate,err)
478980d4a7Sjeremylt      call ceedvectorview(y,err)
488980d4a7Sjeremylt
498980d4a7Sjeremylt!    Transpose
508980d4a7Sjeremylt      call ceedvectorgetarray(x,ceed_mem_host,a,aoffset,err)
518980d4a7Sjeremylt      do i=1,ne+1
528980d4a7Sjeremylt        a(aoffset+i)=0.0
538980d4a7Sjeremylt      enddo
548980d4a7Sjeremylt      call ceedvectorrestorearray(x,a,aoffset,err)
558980d4a7Sjeremylt
568980d4a7Sjeremylt      call ceedelemrestrictionapply(r,ceed_transpose,ceed_notranspose,y,x,&
578980d4a7Sjeremylt     & ceed_request_immediate,err)
588980d4a7Sjeremylt
598980d4a7Sjeremylt      call ceedvectorview(x,err)
608980d4a7Sjeremylt
618980d4a7Sjeremylt      call ceedvectordestroy(x,err)
628980d4a7Sjeremylt      call ceedvectordestroy(y,err)
638980d4a7Sjeremylt      call ceedelemrestrictiondestroy(r,err)
648980d4a7Sjeremylt      call ceeddestroy(ceed,err)
658980d4a7Sjeremylt
668980d4a7Sjeremylt      end
678980d4a7Sjeremylt!-----------------------------------------------------------------------
68