xref: /libCEED/tests/t534-operator-f.h (revision 752c3701a992135134df075f4ef18abc790b3495)
1*752c3701SJeremy L Thompson !-----------------------------------------------------------------------
2*752c3701SJeremy L Thompson       subroutine setup(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,&
3*752c3701SJeremy L Thompson &           u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr)
4*752c3701SJeremy L Thompson       real*8 ctx
5*752c3701SJeremy L Thompson       real*8 u1(1)
6*752c3701SJeremy L Thompson       real*8 u2(1)
7*752c3701SJeremy L Thompson       real*8 v1(1)
8*752c3701SJeremy L Thompson       real*8 w
9*752c3701SJeremy L Thompson       integer q,ierr
10*752c3701SJeremy L Thompson 
11*752c3701SJeremy L Thompson       do i=1,q
12*752c3701SJeremy L Thompson         w=u2(i)/(u1(i+q*0)*u1(i+q*3)-u1(i+q*1)*u1(i+q*2))
13*752c3701SJeremy L Thompson         v1(i+q*0)=w*(u1(i+q*2)*u1(i+q*2)+u1(i+q*3)*u1(i+q*3))
14*752c3701SJeremy L Thompson         v1(i+q*1)=-w*(u1(i+q*0)*u1(i+q*2)+u1(i+q*2)*u1(i+q*3))
15*752c3701SJeremy L Thompson         v1(i+q*2)=w*(u1(i+q*0)*u1(i+q*0)+u1(i+q*1)*u1(i+q*1))
16*752c3701SJeremy L Thompson       enddo
17*752c3701SJeremy L Thompson 
18*752c3701SJeremy L Thompson       ierr=0
19*752c3701SJeremy L Thompson       end
20*752c3701SJeremy L Thompson !-----------------------------------------------------------------------
21*752c3701SJeremy L Thompson       subroutine diff(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,&
22*752c3701SJeremy L Thompson &           u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr)
23*752c3701SJeremy L Thompson       real*8 ctx
24*752c3701SJeremy L Thompson       real*8 u1(1)
25*752c3701SJeremy L Thompson       real*8 u2(1)
26*752c3701SJeremy L Thompson       real*8 v1(1)
27*752c3701SJeremy L Thompson       real*8 du0,du1
28*752c3701SJeremy L Thompson       integer q,ierr
29*752c3701SJeremy L Thompson 
30*752c3701SJeremy L Thompson       do i=1,q
31*752c3701SJeremy L Thompson         du0=u1(i+q*0)
32*752c3701SJeremy L Thompson         du1=u1(i+q*1)
33*752c3701SJeremy L Thompson         v1(i+q*0)=u2(i+q*0)*du0+u2(i+q*2)*du1
34*752c3701SJeremy L Thompson         v1(i+q*1)=u2(i+q*2)*du0+u2(i+q*1)*du1
35*752c3701SJeremy L Thompson       enddo
36*752c3701SJeremy L Thompson 
37*752c3701SJeremy L Thompson       ierr=0
38*752c3701SJeremy L Thompson       end
39*752c3701SJeremy L Thompson !-----------------------------------------------------------------------
40