xref: /libCEED/tests/t320-basis-f.h (revision d4cc18453651bd0f94c1a2e078b2646a92dafdcc)
1*9ba83ac0SJeremy L Thompson ! Copyright (c) 2017-2026, Lawrence Livermore National Security, LLC and other CEED contributors.
2ac5aa7bcSJeremy L Thompson ! All Rights Reserved. See the top-level LICENSE and NOTICE files for details.
307a3c987Svaleriabarra !
4ac5aa7bcSJeremy L Thompson ! SPDX-License-Identifier: BSD-2-Clause
507a3c987Svaleriabarra !
6ac5aa7bcSJeremy L Thompson ! This file is part of CEED:  http://github.com/ceed
707a3c987Svaleriabarra !
852bfb9bbSJeremy L Thompson !-----------------------------------------------------------------------
952bfb9bbSJeremy L Thompson       subroutine buildmats(qref,qweight,interp,grad)
1052bfb9bbSJeremy L Thompson       integer p,q,d
1152bfb9bbSJeremy L Thompson       parameter(p=6)
1252bfb9bbSJeremy L Thompson       parameter(q=4)
1352bfb9bbSJeremy L Thompson       parameter(d=2)
1452bfb9bbSJeremy L Thompson 
1552bfb9bbSJeremy L Thompson       real*8 qref(d*q)
1652bfb9bbSJeremy L Thompson       real*8 qweight(q)
1752bfb9bbSJeremy L Thompson       real*8 interp(p*q)
1852bfb9bbSJeremy L Thompson       real*8 grad(d*p*q)
1952bfb9bbSJeremy L Thompson       real*8 x1,x2
2052bfb9bbSJeremy L Thompson 
2152bfb9bbSJeremy L Thompson       qref=(/2.d-1,6.d-1,1.d0/3.d0,2.d-1,2.d-1,2.d-1,1.d0/3.d0,6.d-1/)
2252bfb9bbSJeremy L Thompson       qweight=(/25.d0/96.d0,25.d0/96.d0,-27.d0/96.d0,25.d0/96.d0/)
2352bfb9bbSJeremy L Thompson 
2452bfb9bbSJeremy L Thompson       do i=0,q-1
2552bfb9bbSJeremy L Thompson         x1 = qref(0*q+i+1)
2652bfb9bbSJeremy L Thompson         x2 = qref(1*q+i+1);
2752bfb9bbSJeremy L Thompson !       Interp
2852bfb9bbSJeremy L Thompson         interp(i*P+1)=2.*(x1+x2-1.)*(x1+x2-1./2.);
2952bfb9bbSJeremy L Thompson         interp(i*P+2)=-4.*x1*(x1+x2-1.);
3052bfb9bbSJeremy L Thompson         interp(i*P+3)=2.*x1*(x1-1./2.);
3152bfb9bbSJeremy L Thompson         interp(i*P+4)=-4.*x2*(x1+x2-1.);
3252bfb9bbSJeremy L Thompson         interp(i*P+5)=4.*x1*x2;
3352bfb9bbSJeremy L Thompson         interp(i*P+6)=2.*x2*(x2-1./2.);
3452bfb9bbSJeremy L Thompson !       Grad
3552bfb9bbSJeremy L Thompson         grad((i+0)*P+1)=2.*(1.*(x1+x2-1./2.)+(x1+x2-1.)*1.);
3652bfb9bbSJeremy L Thompson         grad((i+Q)*P+1)=2.*(1.*(x1+x2-1./2.)+(x1+x2-1.)*1.);
3752bfb9bbSJeremy L Thompson         grad((i+0)*P+2)=-4.*(1.*(x1+x2-1.)+x1*1.);
3852bfb9bbSJeremy L Thompson         grad((i+Q)*P+2)=-4.*(x1*1.);
3952bfb9bbSJeremy L Thompson         grad((i+0)*P+3)=2.*(1.*(x1-1./2.)+x1*1.);
4052bfb9bbSJeremy L Thompson         grad((i+Q)*P+3)=2.*0.;
4152bfb9bbSJeremy L Thompson         grad((i+0)*P+4)=-4.*(x2*1.);
4252bfb9bbSJeremy L Thompson         grad((i+Q)*P+4)=-4.*(1.*(x1+x2-1.)+x2*1.);
4352bfb9bbSJeremy L Thompson         grad((i+0)*P+5)=4.*(1.*x2);
4452bfb9bbSJeremy L Thompson         grad((i+Q)*P+5)=4.*(x1*1.);
4552bfb9bbSJeremy L Thompson         grad((i+0)*P+6)=2.*0.;
4652bfb9bbSJeremy L Thompson         grad((i+Q)*P+6)=2.*(1.*(x2-1./2.)+x2*1.);
4752bfb9bbSJeremy L Thompson       enddo
4852bfb9bbSJeremy L Thompson 
4952bfb9bbSJeremy L Thompson       end
5052bfb9bbSJeremy L Thompson !-----------------------------------------------------------------------
51