xref: /libCEED/tests/t402-qfunction-f.f90 (revision 6a6b797f790a7f197cde448212987b3ead5d18fa)
175affc3bSjeremylt!-----------------------------------------------------------------------
2752c3701SJeremy L Thompson!
3752c3701SJeremy L Thompson! Header with QFunctions
4752c3701SJeremy L Thompson!
5752c3701SJeremy L Thompson      include 't401-qfunction-f.h'
675affc3bSjeremylt!-----------------------------------------------------------------------
775affc3bSjeremylt      program test
81f9a83abSJed Brown      implicit none
9ec3da8bcSJed Brown      include 'ceed/fortran.h'
1075affc3bSjeremylt
1175affc3bSjeremylt      integer ceed,err
1275affc3bSjeremylt      integer qf_setup,qf_mass
13777ff853SJeremy L Thompson      integer ctx
14777ff853SJeremy L Thompson      integer ctxsize
15777ff853SJeremy L Thompson      parameter(ctxsize=5)
16777ff853SJeremy L Thompson      real*8 ctxdata(5)
17777ff853SJeremy L Thompson
1875affc3bSjeremylt      character arg*32
19777ff853SJeremy L Thompson      integer*8 coffset
2075affc3bSjeremylt
21f1a4e9feSjeremylt! LCOV_EXCL_START
2275affc3bSjeremylt      external setup,mass
23f1a4e9feSjeremylt! LCOV_EXCL_STOP
2475affc3bSjeremylt
25777ff853SJeremy L Thompson      ctxdata=(/1.d0,2.d0,3.d0,4.d0,5.d0/)
26777ff853SJeremy L Thompson
2775affc3bSjeremylt      call getarg(1,arg)
2875affc3bSjeremylt      call ceedinit(trim(arg)//char(0),ceed,err)
2975affc3bSjeremylt
3075affc3bSjeremylt      call ceedqfunctioncreateinterior(ceed,1,setup,&
3175affc3bSjeremylt     &SOURCE_DIR&
3275affc3bSjeremylt     &//'t400-qfunction.h:setup'//char(0),qf_setup,err)
3384e209c4Sjeremylt      call ceedqfunctionaddinput(qf_setup,'w', 1,ceed_eval_weight,err)
3484e209c4Sjeremylt      call ceedqfunctionaddoutput(qf_setup,'qdata',1,ceed_eval_none,err)
3575affc3bSjeremylt
3675affc3bSjeremylt      call ceedqfunctioncreateinterior(ceed,1,mass,&
3775affc3bSjeremylt     &SOURCE_DIR&
3875affc3bSjeremylt     &//'t400-qfunction.h:mass'//char(0),qf_mass,err)
3984e209c4Sjeremylt      call ceedqfunctionaddinput(qf_mass,'qdata',1,ceed_eval_none,err)
4075affc3bSjeremylt      call ceedqfunctionaddinput(qf_mass,'u',1,ceed_eval_interp,err)
4175affc3bSjeremylt      call ceedqfunctionaddoutput(qf_mass,'v',1,ceed_eval_interp,err)
4275affc3bSjeremylt
4375affc3bSjeremylt      call ceedqfunctionview(qf_setup,err)
4475affc3bSjeremylt      call ceedqfunctionview(qf_mass,err)
4575affc3bSjeremylt
46777ff853SJeremy L Thompson      call ceedqfunctioncontextcreate(ceed,ctx,err)
47777ff853SJeremy L Thompson      coffset=0
48777ff853SJeremy L Thompson      call ceedqfunctioncontextsetdata(ctx,ceed_mem_host,ceed_use_pointer,ctxsize,&
49777ff853SJeremy L Thompson     & ctxdata,coffset,err)
50777ff853SJeremy L Thompson      call ceedqfunctioncontextview(ctx,err)
51777ff853SJeremy L Thompson
52*13a7d540SJeremy L Thompson      call ceedqfunctionsetnumviewtabs(qf_mass,1,err)
53*13a7d540SJeremy L Thompson      call ceedqfunctionview(qf_mass,err)
54*13a7d540SJeremy L Thompson      call ceedqfunctioncontextsetnumviewtabs(ctx,1,err)
55*13a7d540SJeremy L Thompson      call ceedqfunctioncontextview(ctx,err)
56*13a7d540SJeremy L Thompson
5775affc3bSjeremylt      call ceedqfunctiondestroy(qf_setup,err)
5875affc3bSjeremylt      call ceedqfunctiondestroy(qf_mass,err)
5975affc3bSjeremylt      call ceeddestroy(ceed,err)
6075affc3bSjeremylt      end
6175affc3bSjeremylt!-----------------------------------------------------------------------
62