xref: /libCEED/tests/t411-qfunction-f.f90 (revision fd364f385fcf8d7fc7b4a70eff195ce997d4a2a4)
1!-----------------------------------------------------------------------
2      program test
3      implicit none
4      include 'ceedf.h'
5
6      integer ceed,err
7      integer u,v
8      integer qf
9      integer q,i
10      parameter(q=8)
11      real*8 uu(q)
12      real*8 vv(q)
13      character arg*32
14      integer*8 uoffset,voffset
15
16      call getarg(1,arg)
17      call ceedinit(trim(arg)//char(0),ceed,err)
18
19      call ceedqfunctioncreateidentity(ceed,1,ceed_eval_interp,&
20     & ceed_eval_interp,qf,err)
21
22      do i=0,q-1
23        uu(i+1)=i*i
24      enddo
25
26      call ceedvectorcreate(ceed,q,u,err)
27      uoffset=0
28      call ceedvectorsetarray(u,ceed_mem_host,ceed_use_pointer,uu,uoffset,err)
29      call ceedvectorcreate(ceed,q,v,err)
30      call ceedvectorsetvalue(v,0.d0,err)
31
32      call ceedqfunctionapply(qf,q,u,ceed_null,ceed_null,ceed_null,&
33             &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,&
34             &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,&
35             &v,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,&
36             &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,&
37             &ceed_null,ceed_null,ceed_null,ceed_null,err)
38
39      call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err)
40      do i=1,q
41        if (abs(vv(i+voffset)-(i-1)*(i-1)) > 1.0D-14) then
42! LCOV_EXCL_START
43          write(*,*) 'v(i)=',vv(i+voffset),', u(i)=',(i-1)*(i-1)
44! LCOV_EXCL_STOP
45        endif
46      enddo
47      call ceedvectorrestorearrayread(v,vv,voffset,err)
48
49      call ceedvectordestroy(u,err)
50      call ceedvectordestroy(v,err)
51      call ceedqfunctiondestroy(qf,err)
52      call ceeddestroy(ceed,err)
53      end
54!-----------------------------------------------------------------------
55