1!----------------------------------------------------------------------- 2! 3! Header with common subroutine 4! 5 include 't320-basis-f.h' 6! 7! Header with QFunctions 8! 9 include 't510-operator-f.h' 10!----------------------------------------------------------------------- 11 program test 12 implicit none 13 include 'ceedf.h' 14 15 integer ceed,err,i 16 integer stridesu(3) 17 integer erestrictx,erestrictu,erestrictui 18 integer bx,bu 19 integer qf_setup,qf_mass 20 integer op_setup,op_mass 21 integer qdata,x,u,v 22 integer nelem,p,q,d 23 integer val,row,col,offset 24 parameter(nelem=12) 25 parameter(p=6) 26 parameter(q=4) 27 parameter(d=2) 28 integer ndofs,nqpts,nx,ny 29 parameter(nx=3) 30 parameter(ny=2) 31 parameter(ndofs=(nx*2+1)*(ny*2+1)) 32 parameter(nqpts=nelem*q) 33 integer indx(nelem*p) 34 real*8 arrx(d*ndofs) 35 integer*8 voffset,xoffset 36 37 real*8 qref(d*q) 38 real*8 qweight(q) 39 real*8 interp(p*q) 40 real*8 grad(d*p*q) 41 real*8 total 42 43 real*8 hv(ndofs) 44 45 character arg*32 46 47 external setup,mass 48 49 call getarg(1,arg) 50 51 call ceedinit(trim(arg)//char(0),ceed,err) 52 53 do i=0,ndofs-1 54 arrx(i+1)=mod(i,(nx*2+1)) 55 arrx(i+1)=arrx(i+1)*(1.d0/(nx*2.d0)) 56 val=(i/(nx*2+1)) 57 arrx(i+1+ndofs)=val*(1.d0/(ny*2.d0)) 58 enddo 59 do i=0,5 60 col=mod(i,nx) 61 row=i/nx 62 offset=col*2+row*(nx*2+1)*2 63 64 indx(i*2*p+1)=2+offset 65 indx(i*2*p+2)=9+offset 66 indx(i*2*p+3)=16+offset 67 indx(i*2*p+4)=1+offset 68 indx(i*2*p+5)=8+offset 69 indx(i*2*p+6)=0+offset 70 71 indx(i*2*p+7)=14+offset 72 indx(i*2*p+8)=7+offset 73 indx(i*2*p+9)=0+offset 74 indx(i*2*p+10)=15+offset 75 indx(i*2*p+11)=8+offset 76 indx(i*2*p+12)=16+offset 77 enddo 78 79 call ceedelemrestrictioncreate(ceed,nelem,p,d,ndofs,d*ndofs,& 80 & ceed_mem_host,ceed_use_pointer,indx,erestrictx,err) 81 82 call ceedelemrestrictioncreate(ceed,nelem,p,1,1,ndofs,ceed_mem_host,& 83 & ceed_use_pointer,indx,erestrictu,err) 84 stridesu=[1,q,q] 85 call ceedelemrestrictioncreatestrided(ceed,nelem,q,1,nqpts,stridesu,& 86 & erestrictui,err) 87 88 call buildmats(qref,qweight,interp,grad) 89 call ceedbasiscreateh1(ceed,ceed_triangle,d,p,q,interp,grad,qref,qweight,& 90 & bx,err) 91 call buildmats(qref,qweight,interp,grad) 92 call ceedbasiscreateh1(ceed,ceed_triangle,1,p,q,interp,grad,qref,qweight,& 93 & bu,err) 94 95 call ceedqfunctioncreateinterior(ceed,1,setup,& 96 &SOURCE_DIR& 97 &//'t510-operator.h:setup'//char(0),qf_setup,err) 98 call ceedqfunctionaddinput(qf_setup,'_weight',1,ceed_eval_weight,err) 99 call ceedqfunctionaddinput(qf_setup,'x',d*d,ceed_eval_grad,err) 100 call ceedqfunctionaddoutput(qf_setup,'rho',1,ceed_eval_none,err) 101 102 call ceedqfunctioncreateinterior(ceed,1,mass,& 103 &SOURCE_DIR& 104 &//'t510-operator.h:mass'//char(0),qf_mass,err) 105 call ceedqfunctionaddinput(qf_mass,'rho',1,ceed_eval_none,err) 106 call ceedqfunctionaddinput(qf_mass,'u',1,ceed_eval_interp,err) 107 call ceedqfunctionaddoutput(qf_mass,'v',1,ceed_eval_interp,err) 108 109 call ceedoperatorcreate(ceed,qf_setup,ceed_qfunction_none,& 110 & ceed_qfunction_none,op_setup,err) 111 call ceedoperatorcreate(ceed,qf_mass,ceed_qfunction_none,& 112 & ceed_qfunction_none,op_mass,err) 113 114 call ceedvectorcreate(ceed,d*ndofs,x,err) 115 xoffset=0 116 call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,arrx,xoffset,err) 117 call ceedvectorcreate(ceed,nqpts,qdata,err) 118 119 call ceedoperatorsetfield(op_setup,'_weight',ceed_elemrestriction_none,& 120 & bx,ceed_vector_none,err) 121 call ceedoperatorsetfield(op_setup,'x',erestrictx,bx,& 122 & ceed_vector_active,err) 123 call ceedoperatorsetfield(op_setup,'rho',erestrictui,& 124 & ceed_basis_collocated,ceed_vector_active,err) 125 call ceedoperatorsetfield(op_mass,'rho',erestrictui,& 126 & ceed_basis_collocated,qdata,err) 127 call ceedoperatorsetfield(op_mass,'u',erestrictu,bu,& 128 & ceed_vector_active,err) 129 call ceedoperatorsetfield(op_mass,'v',erestrictu,bu,& 130 & ceed_vector_active,err) 131 132 call ceedoperatorapply(op_setup,x,qdata,ceed_request_immediate,err) 133 134 call ceedvectorcreate(ceed,ndofs,u,err) 135 call ceedvectorsetvalue(u,1.d0,err) 136 call ceedvectorcreate(ceed,ndofs,v,err) 137 call ceedoperatorapply(op_mass,u,v,ceed_request_immediate,err) 138 139 call ceedvectorgetarrayread(v,ceed_mem_host,hv,voffset,err) 140 total=0. 141 do i=1,ndofs 142 total=total+hv(voffset+i) 143 enddo 144 if (abs(total-1.)>1.0d-10) then 145! LCOV_EXCL_START 146 write(*,*) 'Computed Area: ',total,' != True Area: 1.0' 147! LCOV_EXCL_STOP 148 endif 149 call ceedvectorrestorearrayread(v,hv,voffset,err) 150 151 call ceedvectordestroy(qdata,err) 152 call ceedvectordestroy(x,err) 153 call ceedvectordestroy(u,err) 154 call ceedvectordestroy(v,err) 155 call ceedoperatordestroy(op_mass,err) 156 call ceedoperatordestroy(op_setup,err) 157 call ceedqfunctiondestroy(qf_mass,err) 158 call ceedqfunctiondestroy(qf_setup,err) 159 call ceedbasisdestroy(bu,err) 160 call ceedbasisdestroy(bx,err) 161 call ceedelemrestrictiondestroy(erestrictu,err) 162 call ceedelemrestrictiondestroy(erestrictx,err) 163 call ceedelemrestrictiondestroy(erestrictui,err) 164 call ceeddestroy(ceed,err) 165 end 166!----------------------------------------------------------------------- 167