1!----------------------------------------------------------------------- 2 subroutine setup(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 3& u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 4 real*8 ctx(1) 5 real*8 u1(8) 6 real*8 v1(8) 7 integer q,ierr 8 9 do i=1,q 10 v1(i)=u1(i) 11 enddo 12 13 ierr=0 14 end 15!----------------------------------------------------------------------- 16 subroutine mass(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 17& u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 18 real*8 ctx(1) 19 real*8 u1(8) 20 real*8 u2(8) 21 real*8 v1(8) 22 integer q,ierr 23 24 do i=1,q 25 v1(i)=u1(i)*u2(i) 26 enddo 27 28 ierr=0 29 end 30!----------------------------------------------------------------------- 31 program test 32 33 include 'ceedf.h' 34 35 integer ceed,err 36 integer qf_setup,qf_mass 37 character arg*32 38 39 external setup,mass 40 41 call getarg(1,arg) 42 call ceedinit(trim(arg)//char(0),ceed,err) 43 44 call ceedqfunctioncreateinterior(ceed,1,setup,& 45 &SOURCE_DIR& 46 &//'t400-qfunction.h:setup'//char(0),qf_setup,err) 47 call ceedqfunctionaddinput(qf_setup,'w', 1,ceed_eval_interp,err) 48 call ceedqfunctionaddoutput(qf_setup,'qdata',1,ceed_eval_interp,err) 49 50 call ceedqfunctioncreateinterior(ceed,1,mass,& 51 &SOURCE_DIR& 52 &//'t400-qfunction.h:mass'//char(0),qf_mass,err) 53 call ceedqfunctionaddinput(qf_mass,'qdata',1,ceed_eval_interp,err) 54 call ceedqfunctionaddinput(qf_mass,'u',1,ceed_eval_interp,err) 55 call ceedqfunctionaddoutput(qf_mass,'v',1,ceed_eval_interp,err) 56 57 call ceedqfunctionview(qf_setup,err) 58 call ceedqfunctionview(qf_mass,err) 59 60 call ceedqfunctiondestroy(qf_setup,err) 61 call ceedqfunctiondestroy(qf_mass,err) 62 call ceeddestroy(ceed,err) 63 end 64!----------------------------------------------------------------------- 65