1752c3701SJeremy L Thompson !----------------------------------------------------------------------- 2752c3701SJeremy L Thompson subroutine setup(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 3752c3701SJeremy L Thompson & u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 4752c3701SJeremy L Thompson real*8 ctx 5752c3701SJeremy L Thompson real*8 u1(1) 6752c3701SJeremy L Thompson real*8 u2(1) 7752c3701SJeremy L Thompson real*8 v1(1) 8752c3701SJeremy L Thompson real*8 w 9752c3701SJeremy L Thompson integer q,ierr 10752c3701SJeremy L Thompson 11752c3701SJeremy L Thompson do i=1,q 12752c3701SJeremy L Thompson w=u2(i)/(u1(i+q*0)*u1(i+q*3)-u1(i+q*1)*u1(i+q*2)) 13752c3701SJeremy L Thompson v1(i+q*0)=w*(u1(i+q*2)*u1(i+q*2)+u1(i+q*3)*u1(i+q*3)) 14*68ebe796SJeremy L Thompson v1(i+q*1)=w*(u1(i+q*0)*u1(i+q*0)+u1(i+q*1)*u1(i+q*1)) 15*68ebe796SJeremy L Thompson v1(i+q*2)=-w*(u1(i+q*0)*u1(i+q*2)+u1(i+q*2)*u1(i+q*3)) 16752c3701SJeremy L Thompson enddo 17752c3701SJeremy L Thompson 18752c3701SJeremy L Thompson ierr=0 19752c3701SJeremy L Thompson end 20752c3701SJeremy L Thompson !----------------------------------------------------------------------- 21752c3701SJeremy L Thompson subroutine diff(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 22752c3701SJeremy L Thompson & u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 23752c3701SJeremy L Thompson real*8 ctx 24752c3701SJeremy L Thompson real*8 u1(1) 25752c3701SJeremy L Thompson real*8 u2(1) 26752c3701SJeremy L Thompson real*8 v1(1) 27752c3701SJeremy L Thompson real*8 du0,du1 28752c3701SJeremy L Thompson integer q,ierr 29752c3701SJeremy L Thompson 30752c3701SJeremy L Thompson do i=1,q 31752c3701SJeremy L Thompson du0=u1(i+q*0) 32752c3701SJeremy L Thompson du1=u1(i+q*1) 33752c3701SJeremy L Thompson v1(i+q*0)=u2(i+q*0)*du0+u2(i+q*1)*du1 34752c3701SJeremy L Thompson v1(i+q*1)=u2(i+q*1)*du0+u2(i+q*2)*du1 35752c3701SJeremy L Thompson enddo 36752c3701SJeremy L Thompson 37752c3701SJeremy L Thompson ierr=0 38752c3701SJeremy L Thompson end 39752c3701SJeremy L Thompson !----------------------------------------------------------------------- 40752c3701SJeremy L Thompson subroutine diff_lin(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 41752c3701SJeremy L Thompson & u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 42752c3701SJeremy L Thompson real*8 ctx 43752c3701SJeremy L Thompson real*8 u1(1) 44752c3701SJeremy L Thompson real*8 u2(1) 45752c3701SJeremy L Thompson real*8 v1(1) 46752c3701SJeremy L Thompson real*8 du0,du1 47752c3701SJeremy L Thompson integer q,ierr 48752c3701SJeremy L Thompson 49752c3701SJeremy L Thompson do i=1,q 50752c3701SJeremy L Thompson du0=u1(i+q*0) 51752c3701SJeremy L Thompson du1=u1(i+q*1) 52752c3701SJeremy L Thompson v1(i+q*0)=u2(i+q*0)*du0+u2(i+q*1)*du1 53752c3701SJeremy L Thompson v1(i+q*1)=u2(i+q*2)*du0+u2(i+q*3)*du1 54752c3701SJeremy L Thompson enddo 55752c3701SJeremy L Thompson 56752c3701SJeremy L Thompson ierr=0 57752c3701SJeremy L Thompson end 58752c3701SJeremy L Thompson !----------------------------------------------------------------------- 59