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) 4f1a4e9feSjeremylt! LCOV_EXCL_START 52ebaca42Sjeremylt real*8 ctx 62ebaca42Sjeremylt real*8 u1(1) 72ebaca42Sjeremylt real*8 u2(1) 82ebaca42Sjeremylt real*8 v1(1) 92ebaca42Sjeremylt integer q,ierr 102ebaca42Sjeremylt 112ebaca42Sjeremylt do i=1,q 122ebaca42Sjeremylt v1(i)=u1(i)*u2(i) 132ebaca42Sjeremylt enddo 142ebaca42Sjeremylt 152ebaca42Sjeremylt ierr=0 162ebaca42Sjeremylt end 17f1a4e9feSjeremylt! LCOV_EXCL_STOP 182ebaca42Sjeremylt!----------------------------------------------------------------------- 192ebaca42Sjeremylt subroutine mass(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 202ebaca42Sjeremylt& u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 21f1a4e9feSjeremylt! LCOV_EXCL_START 222ebaca42Sjeremylt real*8 ctx 232ebaca42Sjeremylt real*8 u1(1) 242ebaca42Sjeremylt real*8 u2(1) 252ebaca42Sjeremylt real*8 v1(1) 262ebaca42Sjeremylt integer q,ierr 272ebaca42Sjeremylt 282ebaca42Sjeremylt do i=1,q 292ebaca42Sjeremylt v1(i)=u2(i)*u1(i) 302ebaca42Sjeremylt enddo 312ebaca42Sjeremylt 322ebaca42Sjeremylt ierr=0 332ebaca42Sjeremylt end 34f1a4e9feSjeremylt! LCOV_EXCL_STOP 352ebaca42Sjeremylt!----------------------------------------------------------------------- 362ebaca42Sjeremylt program test 37*1f9a83abSJed Brown implicit none 382ebaca42Sjeremylt include 'ceedf.h' 392ebaca42Sjeremylt 402ebaca42Sjeremylt integer ceed,err,i,j 4115910d16Sjeremylt integer stridesu(3) 4215910d16Sjeremylt integer erestrictx,erestrictu,erestrictui 432ebaca42Sjeremylt integer bx,bu 442ebaca42Sjeremylt integer qf_setup,qf_mass 452ebaca42Sjeremylt integer op_setup,op_mass 46*1f9a83abSJed Brown integer x,qdata 472ebaca42Sjeremylt integer nelem,p,q 482ebaca42Sjeremylt parameter(nelem=15) 492ebaca42Sjeremylt parameter(p=5) 502ebaca42Sjeremylt parameter(q=8) 512ebaca42Sjeremylt integer nx,nu 522ebaca42Sjeremylt parameter(nx=nelem+1) 532ebaca42Sjeremylt parameter(nu=nelem*(p-1)+1) 542ebaca42Sjeremylt integer indx(nelem*2) 552ebaca42Sjeremylt integer indu(nelem*p) 562ebaca42Sjeremylt 572ebaca42Sjeremylt character arg*32 582ebaca42Sjeremylt 59f1a4e9feSjeremylt! LCOV_EXCL_START 602ebaca42Sjeremylt external setup,mass 61f1a4e9feSjeremylt! LCOV_EXCL_STOP 622ebaca42Sjeremylt 632ebaca42Sjeremylt call getarg(1,arg) 642ebaca42Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 652ebaca42Sjeremylt 662ebaca42Sjeremylt do i=0,nelem-1 672ebaca42Sjeremylt indx(2*i+1)=i 682ebaca42Sjeremylt indx(2*i+2)=i+1 692ebaca42Sjeremylt enddo 702ebaca42Sjeremylt 71d979a051Sjeremylt call ceedelemrestrictioncreate(ceed,nelem,2,1,1,nx,ceed_mem_host,& 722ebaca42Sjeremylt & ceed_use_pointer,indx,erestrictx,err) 732ebaca42Sjeremylt 742ebaca42Sjeremylt do i=0,nelem-1 752ebaca42Sjeremylt do j=0,p-1 76d979a051Sjeremylt indu(p*i+j+1)=2*(i*(p-1)+j) 772ebaca42Sjeremylt enddo 782ebaca42Sjeremylt enddo 792ebaca42Sjeremylt 80d979a051Sjeremylt call ceedelemrestrictioncreate(ceed,nelem,p,2,1,2*nu,ceed_mem_host,& 812ebaca42Sjeremylt & ceed_use_pointer,indu,erestrictu,err) 827509a596Sjeremylt stridesu=[1,q,q] 83d979a051Sjeremylt call ceedelemrestrictioncreatestrided(ceed,nelem,q,1,q*nelem,stridesu,& 842ebaca42Sjeremylt & erestrictui,err) 852ebaca42Sjeremylt 862ebaca42Sjeremylt call ceedbasiscreatetensorh1lagrange(ceed,1,1,2,q,ceed_gauss,bx,err) 87d979a051Sjeremylt call ceedbasiscreatetensorh1lagrange(ceed,1,2,p,q,ceed_gauss,bu,err) 882ebaca42Sjeremylt 892ebaca42Sjeremylt call ceedqfunctioncreateinterior(ceed,1,setup,& 902ebaca42Sjeremylt &SOURCE_DIR& 912ebaca42Sjeremylt &//'t500-operator.h:setup'//char(0),qf_setup,err) 922ebaca42Sjeremylt call ceedqfunctionaddinput(qf_setup,'_weight',1,ceed_eval_weight,err) 932ebaca42Sjeremylt call ceedqfunctionaddinput(qf_setup,'dx',1,ceed_eval_grad,err) 942ebaca42Sjeremylt call ceedqfunctionaddoutput(qf_setup,'rho',1,ceed_eval_none,err) 952ebaca42Sjeremylt 962ebaca42Sjeremylt call ceedqfunctioncreateinterior(ceed,1,mass,& 972ebaca42Sjeremylt &SOURCE_DIR& 982ebaca42Sjeremylt &//'t500-operator.h:mass'//char(0),qf_mass,err) 992ebaca42Sjeremylt call ceedqfunctionaddinput(qf_mass,'rho',1,ceed_eval_none,err) 100d979a051Sjeremylt call ceedqfunctionaddinput(qf_mass,'u',2,ceed_eval_interp,err) 101d979a051Sjeremylt call ceedqfunctionaddoutput(qf_mass,'v',2,ceed_eval_interp,err) 1022ebaca42Sjeremylt 1032ebaca42Sjeremylt call ceedoperatorcreate(ceed,qf_setup,ceed_qfunction_none,& 1042ebaca42Sjeremylt & ceed_qfunction_none,op_setup,err) 1052ebaca42Sjeremylt call ceedoperatorcreate(ceed,qf_mass,ceed_qfunction_none,& 1062ebaca42Sjeremylt & ceed_qfunction_none,op_mass,err) 1072ebaca42Sjeremylt 1082ebaca42Sjeremylt call ceedvectorcreate(ceed,nx,x,err) 1092ebaca42Sjeremylt call ceedvectorcreate(ceed,nelem*q,qdata,err) 1102ebaca42Sjeremylt 11115910d16Sjeremylt call ceedoperatorsetfield(op_setup,'_weight',ceed_elemrestriction_none,& 11215910d16Sjeremylt & bx,ceed_vector_none,err) 113a8d32208Sjeremylt call ceedoperatorsetfield(op_setup,'dx',erestrictx,bx,& 114a8d32208Sjeremylt & ceed_vector_active,err) 1152ebaca42Sjeremylt call ceedoperatorsetfield(op_setup,'rho',erestrictui,& 116a8d32208Sjeremylt & ceed_basis_collocated,ceed_vector_active,err) 1172ebaca42Sjeremylt call ceedoperatorsetfield(op_mass,'rho',erestrictui,& 118a8d32208Sjeremylt & ceed_basis_collocated,qdata,err) 119a8d32208Sjeremylt call ceedoperatorsetfield(op_mass,'u',erestrictu,bu,& 120a8d32208Sjeremylt & ceed_vector_active,err) 121a8d32208Sjeremylt call ceedoperatorsetfield(op_mass,'v',erestrictu,bu,& 122a8d32208Sjeremylt & ceed_vector_active,err) 1232ebaca42Sjeremylt 1242ebaca42Sjeremylt call ceedoperatorview(op_setup,err) 1252ebaca42Sjeremylt call ceedoperatorview(op_mass,err) 1262ebaca42Sjeremylt 1272ebaca42Sjeremylt call ceedvectordestroy(qdata,err) 1282ebaca42Sjeremylt call ceedoperatordestroy(op_mass,err) 1292ebaca42Sjeremylt call ceedoperatordestroy(op_setup,err) 1302ebaca42Sjeremylt call ceedqfunctiondestroy(qf_mass,err) 1312ebaca42Sjeremylt call ceedqfunctiondestroy(qf_setup,err) 1322ebaca42Sjeremylt call ceedbasisdestroy(bu,err) 1332ebaca42Sjeremylt call ceedbasisdestroy(bx,err) 1342ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictu,err) 1352ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictx,err) 1362ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictui,err) 1372ebaca42Sjeremylt call ceeddestroy(ceed,err) 1382ebaca42Sjeremylt end 1392ebaca42Sjeremylt!----------------------------------------------------------------------- 140