xref: /libCEED/tests/t402-qfunction-f.f90 (revision 84e209c490f9c3b262db4d11bf7f8022aee8d623)
175affc3bSjeremylt!-----------------------------------------------------------------------
275affc3bSjeremylt      subroutine setup(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,&
375affc3bSjeremylt&           u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr)
4f1a4e9feSjeremylt! LCOV_EXCL_START
575affc3bSjeremylt      real*8 ctx(1)
675affc3bSjeremylt      real*8 u1(8)
775affc3bSjeremylt      real*8 v1(8)
875affc3bSjeremylt      integer q,ierr
975affc3bSjeremylt
1075affc3bSjeremylt      do i=1,q
1175affc3bSjeremylt        v1(i)=u1(i)
1275affc3bSjeremylt      enddo
1375affc3bSjeremylt
1475affc3bSjeremylt      ierr=0
1575affc3bSjeremylt      end
16f1a4e9feSjeremylt! LCOV_EXCL_STOP
1775affc3bSjeremylt!-----------------------------------------------------------------------
1875affc3bSjeremylt      subroutine mass(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,&
1975affc3bSjeremylt&           u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr)
20f1a4e9feSjeremylt! LCOV_EXCL_START
2175affc3bSjeremylt      real*8 ctx(1)
2275affc3bSjeremylt      real*8 u1(8)
2375affc3bSjeremylt      real*8 u2(8)
2475affc3bSjeremylt      real*8 v1(8)
2575affc3bSjeremylt      integer q,ierr
2675affc3bSjeremylt
2775affc3bSjeremylt      do i=1,q
2875affc3bSjeremylt        v1(i)=u1(i)*u2(i)
2975affc3bSjeremylt      enddo
3075affc3bSjeremylt
3175affc3bSjeremylt      ierr=0
3275affc3bSjeremylt      end
33f1a4e9feSjeremylt! LCOV_EXCL_STOP
3475affc3bSjeremylt!-----------------------------------------------------------------------
3575affc3bSjeremylt      program test
3675affc3bSjeremylt
3775affc3bSjeremylt      include 'ceedf.h'
3875affc3bSjeremylt
3975affc3bSjeremylt      integer ceed,err
4075affc3bSjeremylt      integer qf_setup,qf_mass
4175affc3bSjeremylt      character arg*32
4275affc3bSjeremylt
43f1a4e9feSjeremylt! LCOV_EXCL_START
4475affc3bSjeremylt      external setup,mass
45f1a4e9feSjeremylt! LCOV_EXCL_STOP
4675affc3bSjeremylt
4775affc3bSjeremylt      call getarg(1,arg)
4875affc3bSjeremylt      call ceedinit(trim(arg)//char(0),ceed,err)
4975affc3bSjeremylt
5075affc3bSjeremylt      call ceedqfunctioncreateinterior(ceed,1,setup,&
5175affc3bSjeremylt     &SOURCE_DIR&
5275affc3bSjeremylt     &//'t400-qfunction.h:setup'//char(0),qf_setup,err)
53*84e209c4Sjeremylt      call ceedqfunctionaddinput(qf_setup,'w', 1,ceed_eval_weight,err)
54*84e209c4Sjeremylt      call ceedqfunctionaddoutput(qf_setup,'qdata',1,ceed_eval_none,err)
5575affc3bSjeremylt
5675affc3bSjeremylt      call ceedqfunctioncreateinterior(ceed,1,mass,&
5775affc3bSjeremylt     &SOURCE_DIR&
5875affc3bSjeremylt     &//'t400-qfunction.h:mass'//char(0),qf_mass,err)
59*84e209c4Sjeremylt      call ceedqfunctionaddinput(qf_mass,'qdata',1,ceed_eval_none,err)
6075affc3bSjeremylt      call ceedqfunctionaddinput(qf_mass,'u',1,ceed_eval_interp,err)
6175affc3bSjeremylt      call ceedqfunctionaddoutput(qf_mass,'v',1,ceed_eval_interp,err)
6275affc3bSjeremylt
6375affc3bSjeremylt      call ceedqfunctionview(qf_setup,err)
6475affc3bSjeremylt      call ceedqfunctionview(qf_mass,err)
6575affc3bSjeremylt
6675affc3bSjeremylt      call ceedqfunctiondestroy(qf_setup,err)
6775affc3bSjeremylt      call ceedqfunctiondestroy(qf_mass,err)
6875affc3bSjeremylt      call ceeddestroy(ceed,err)
6975affc3bSjeremylt      end
7075affc3bSjeremylt!-----------------------------------------------------------------------
71