12ebaca42Sjeremylt!----------------------------------------------------------------------- 22ebaca42Sjeremylt subroutine setup(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 32ebaca42Sjeremylt& u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 42ebaca42Sjeremylt real*8 ctx 52ebaca42Sjeremylt real*8 u1(1) 62ebaca42Sjeremylt real*8 u2(1) 72ebaca42Sjeremylt real*8 v1(1) 82ebaca42Sjeremylt integer q,ierr 92ebaca42Sjeremylt 102ebaca42Sjeremylt do i=1,q 112ebaca42Sjeremylt v1(i)=u1(i)*u2(i) 122ebaca42Sjeremylt enddo 132ebaca42Sjeremylt 142ebaca42Sjeremylt ierr=0 152ebaca42Sjeremylt end 162ebaca42Sjeremylt!----------------------------------------------------------------------- 172ebaca42Sjeremylt subroutine mass(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 182ebaca42Sjeremylt& u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 192ebaca42Sjeremylt real*8 ctx 202ebaca42Sjeremylt real*8 u1(1) 212ebaca42Sjeremylt real*8 u2(1) 222ebaca42Sjeremylt real*8 v1(1) 232ebaca42Sjeremylt integer q,ierr 242ebaca42Sjeremylt 252ebaca42Sjeremylt do i=1,q 262ebaca42Sjeremylt v1(i)=u2(i)*u1(i) 272ebaca42Sjeremylt enddo 282ebaca42Sjeremylt 292ebaca42Sjeremylt ierr=0 302ebaca42Sjeremylt end 312ebaca42Sjeremylt!----------------------------------------------------------------------- 322ebaca42Sjeremylt program test 332ebaca42Sjeremylt 342ebaca42Sjeremylt include 'ceedf.h' 352ebaca42Sjeremylt 362ebaca42Sjeremylt integer ceed,err,i,j 372ebaca42Sjeremylt integer erestrictx,erestrictu,erestrictxi,erestrictui 382ebaca42Sjeremylt integer bx,bu 392ebaca42Sjeremylt integer qf_setup,qf_mass 402ebaca42Sjeremylt integer op_setup,op_mass 412ebaca42Sjeremylt integer qdata 422ebaca42Sjeremylt integer nelem,p,q 432ebaca42Sjeremylt parameter(nelem=15) 442ebaca42Sjeremylt parameter(p=5) 452ebaca42Sjeremylt parameter(q=8) 462ebaca42Sjeremylt integer nx,nu 472ebaca42Sjeremylt parameter(nx=nelem+1) 482ebaca42Sjeremylt parameter(nu=nelem*(p-1)+1) 492ebaca42Sjeremylt integer indx(nelem*2) 502ebaca42Sjeremylt integer indu(nelem*p) 512ebaca42Sjeremylt 522ebaca42Sjeremylt character arg*32 532ebaca42Sjeremylt 542ebaca42Sjeremylt external setup,mass 552ebaca42Sjeremylt 562ebaca42Sjeremylt call getarg(1,arg) 572ebaca42Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 582ebaca42Sjeremylt 592ebaca42Sjeremylt do i=0,nelem-1 602ebaca42Sjeremylt indx(2*i+1)=i 612ebaca42Sjeremylt indx(2*i+2)=i+1 622ebaca42Sjeremylt enddo 632ebaca42Sjeremylt 642ebaca42Sjeremylt call ceedelemrestrictioncreate(ceed,nelem,2,nx,1,ceed_mem_host,& 652ebaca42Sjeremylt & ceed_use_pointer,indx,erestrictx,err) 662ebaca42Sjeremylt call ceedelemrestrictioncreateidentity(ceed,nelem,2,2*nelem,1,& 672ebaca42Sjeremylt & erestrictxi,err) 682ebaca42Sjeremylt 692ebaca42Sjeremylt do i=0,nelem-1 702ebaca42Sjeremylt do j=0,p-1 712ebaca42Sjeremylt indu(p*i+j+1)=i*(p-1)+j 722ebaca42Sjeremylt enddo 732ebaca42Sjeremylt enddo 742ebaca42Sjeremylt 752ebaca42Sjeremylt call ceedelemrestrictioncreate(ceed,nelem,p,nu,1,ceed_mem_host,& 762ebaca42Sjeremylt & ceed_use_pointer,indu,erestrictu,err) 772ebaca42Sjeremylt call ceedelemrestrictioncreateidentity(ceed,nelem,q,q*nelem,1,& 782ebaca42Sjeremylt & erestrictui,err) 792ebaca42Sjeremylt 802ebaca42Sjeremylt call ceedbasiscreatetensorh1lagrange(ceed,1,1,2,q,ceed_gauss,bx,err) 812ebaca42Sjeremylt call ceedbasiscreatetensorh1lagrange(ceed,1,1,p,q,ceed_gauss,bu,err) 822ebaca42Sjeremylt 832ebaca42Sjeremylt call ceedqfunctioncreateinterior(ceed,1,setup,& 842ebaca42Sjeremylt &SOURCE_DIR& 852ebaca42Sjeremylt &//'t500-operator.h:setup'//char(0),qf_setup,err) 862ebaca42Sjeremylt call ceedqfunctionaddinput(qf_setup,'_weight',1,ceed_eval_weight,err) 872ebaca42Sjeremylt call ceedqfunctionaddinput(qf_setup,'dx',1,ceed_eval_grad,err) 882ebaca42Sjeremylt call ceedqfunctionaddoutput(qf_setup,'rho',1,ceed_eval_none,err) 892ebaca42Sjeremylt 902ebaca42Sjeremylt call ceedqfunctioncreateinterior(ceed,1,mass,& 912ebaca42Sjeremylt &SOURCE_DIR& 922ebaca42Sjeremylt &//'t500-operator.h:mass'//char(0),qf_mass,err) 932ebaca42Sjeremylt call ceedqfunctionaddinput(qf_mass,'rho',1,ceed_eval_none,err) 942ebaca42Sjeremylt call ceedqfunctionaddinput(qf_mass,'u',1,ceed_eval_interp,err) 952ebaca42Sjeremylt call ceedqfunctionaddoutput(qf_mass,'v',1,ceed_eval_interp,err) 962ebaca42Sjeremylt 972ebaca42Sjeremylt call ceedoperatorcreate(ceed,qf_setup,ceed_qfunction_none,& 982ebaca42Sjeremylt & ceed_qfunction_none,op_setup,err) 992ebaca42Sjeremylt call ceedoperatorcreate(ceed,qf_mass,ceed_qfunction_none,& 1002ebaca42Sjeremylt & ceed_qfunction_none,op_mass,err) 1012ebaca42Sjeremylt 1022ebaca42Sjeremylt call ceedvectorcreate(ceed,nx,x,err) 1032ebaca42Sjeremylt xoffset=0 1042ebaca42Sjeremylt call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,arrx,xoffset,err) 1052ebaca42Sjeremylt call ceedvectorcreate(ceed,nelem*q,qdata,err) 1062ebaca42Sjeremylt 1072ebaca42Sjeremylt call ceedoperatorsetfield(op_setup,'_weight',erestrictxi,& 1082ebaca42Sjeremylt & ceed_notranspose,bx,ceed_vector_none,err) 1092ebaca42Sjeremylt call ceedoperatorsetfield(op_setup,'dx',erestrictx,& 1102ebaca42Sjeremylt & ceed_notranspose,bx,ceed_vector_active,err) 1112ebaca42Sjeremylt call ceedoperatorsetfield(op_setup,'rho',erestrictui,& 1122ebaca42Sjeremylt & ceed_notranspose,ceed_basis_collocated,ceed_vector_active,err) 1132ebaca42Sjeremylt call ceedoperatorsetfield(op_mass,'rho',erestrictui,& 1142ebaca42Sjeremylt & ceed_notranspose,ceed_basis_collocated,qdata,err) 1152ebaca42Sjeremylt call ceedoperatorsetfield(op_mass,'u',erestrictu,& 116*2da88da5Sjeremylt & ceed_transpose,bu,ceed_vector_active,err) 1172ebaca42Sjeremylt call ceedoperatorsetfield(op_mass,'v',erestrictu,& 118*2da88da5Sjeremylt & ceed_transpose,bu,ceed_vector_active,err) 1192ebaca42Sjeremylt 1202ebaca42Sjeremylt call ceedoperatorview(op_setup,err) 1212ebaca42Sjeremylt call ceedoperatorview(op_mass,err) 1222ebaca42Sjeremylt 1232ebaca42Sjeremylt call ceedvectordestroy(qdata,err) 1242ebaca42Sjeremylt call ceedoperatordestroy(op_mass,err) 1252ebaca42Sjeremylt call ceedoperatordestroy(op_setup,err) 1262ebaca42Sjeremylt call ceedqfunctiondestroy(qf_mass,err) 1272ebaca42Sjeremylt call ceedqfunctiondestroy(qf_setup,err) 1282ebaca42Sjeremylt call ceedbasisdestroy(bu,err) 1292ebaca42Sjeremylt call ceedbasisdestroy(bx,err) 1302ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictu,err) 1312ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictx,err) 1322ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictui,err) 1332ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictxi,err) 1342ebaca42Sjeremylt call ceeddestroy(ceed,err) 1352ebaca42Sjeremylt end 1362ebaca42Sjeremylt!----------------------------------------------------------------------- 137