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