Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Improve calculation of geometry info for Nek BPs #11

Merged
merged 1 commit into from
Jan 10, 2019
Merged

Improve calculation of geometry info for Nek BPs #11

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
70 changes: 28 additions & 42 deletions tests/nek5000_bps/bp1/bp1.usr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -564,9 +564,9 @@ c-----------------------------------------------------------------------
include 'CTIMER' ! ifsync
include 'FDMH1'

parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2))
real gf(lg,lx,lelt) ! Equivalence new gf() data
equivalence (gf,g1m1) ! layout to g1m1...g6m1
parameter (lzq=lx1+1)
parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2),lq=lzq**ldim)
common /bpgfactors/ gf(lg*lq,lelt),bmq(lq,lelt),w3mq(lq)

parameter (lt=lx1*ly1*lz1*lelt)
parameter (ld=lxd*lyd*lzd*lelt)
Expand All @@ -577,21 +577,20 @@ c-----------------------------------------------------------------------
logical ifh3
integer*8 ndof

call geodat1n ! Set up gf() arrays

ifsync = .false.

n = nx1*ny1*nz1*nelt
nzq = nx1+1
ifield = 1
n = nx1*ny1*nz1*nelt

call geodatq (gf,bmq,w3mq,nzq)
call rand_fld_h1(e1)

call copy (e2,e1,n)
call copy (e3,e1,n)
call copy (e2,e1,n)
call copy (e3,e1,n)

nxq = nx1+1
call set_h2_as_rhoJac_GL (h2,nxq)
call copy (h1,e1,n) ! Save exact soln in h1
call set_h2_as_rhoJac_GL (h2,bmq,nzq)
call copy (h1,e1,n) ! Save exact soln in h1

call axhm3 (pap,r1,r2,r3,e1,e2,e3,h1,h2,'bp2')
call vec_dssum (r1,r2,r3,nx1,ny1,nz1)
Expand Down Expand Up @@ -658,9 +657,9 @@ c-----------------------------------------------------------------------
include 'CTIMER' ! ifsync
include 'FDMH1'

parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2))
real gf(lg,lx,lelt) ! Equivalence new gf() data
equivalence (gf,g1m1) ! layout to g1m1...g6m1
parameter (lzq=lx1+1)
parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2),lq=lzq**ldim)
common /bpgfactors/ gf(lg*lq,lelt),bmq(lq,lelt),w3mq(lq)

parameter (lt=lx1*ly1*lz1*lelt)
parameter (ld=lxd*lyd*lzd*lelt)
Expand All @@ -671,21 +670,20 @@ c-----------------------------------------------------------------------
logical ifh3
integer*8 ndof

call geodat1n ! Set up gf() arrays

ifsync = .false.

n = nx1*ny1*nz1*nelt
nzq = nx1+1
ifield = 1
n = nx1*ny1*nz1*nelt

call geodatq (gf,bmq,w3mq,nzq)
call rand_fld_h1(e1)

call copy (e2,e1,n)
call copy (e3,e1,n)
call copy (e2,e1,n)
call copy (e3,e1,n)

nxq = nx1+1
call set_h2_as_rhoJac_GL (h2,nxq)
call copy (h1,e1,n) ! Save exact soln in h1
call set_h2_as_rhoJac_GL (h2,bmq,nzq)
call copy (h1,e1,n) ! Save exact soln in h1

call axhm3 (pap,r1,r2,r3,e1,e2,e3,h1,h2,'bp2')
call vec_dssum (r1,r2,r3,nx1,ny1,nz1)
Expand Down Expand Up @@ -780,31 +778,19 @@ c-----------------------------------------------------------------------
return
end
c-----------------------------------------------------------------------
subroutine set_h2_as_rhoJac_GL(h2,nxq)
subroutine set_h2_as_rhoJac_GL(h2,bmq,nxq)
include 'SIZE'
real h2(1)

common /ctmp77/ wd(lxd),zd(lxd)
integer e

call zwgl(zd,wd,nxq) ! nxq = number of points
real h2(1),bmq(1)

integer i,lq

q = 1.0 ! Later, this can be a function of position...

L=0
do e=1,nelt
do k=1,nxq
do j=1,nxq
do i=1,nxq
L=L+1
h2(L) = q*wd(i)*wd(j)*wd(k)
enddo
enddo
enddo
enddo

lq = nxq**ldim*nelt

do i=1,lq
h2(i) = q*bmq(i)
enddo
return
end
c-----------------------------------------------------------------------
Expand Down Expand Up @@ -966,7 +952,6 @@ c (Gauss-Legendre Lobatto mesh).

real gf(lg,nzq**ldim,lelt),bmq(nzq**ldim,lelt),w3mq(nzq,nzq,nzq)

common /ctmp0/ tmp(lxyd)
common /ctmp1/ xr(lxyd),xs(lxyd),xt(lxyd)
common /sxrns/ yr(lxyd),ys(lxyd),yt(lxyd)
$ , zr(lxyd),zs(lxyd),zt(lxyd)
Expand All @@ -976,6 +961,7 @@ c (Gauss-Legendre Lobatto mesh).

integer e
real jacmq
real tmp(lxyd)

if (nzq.gt.lzq) call exitti('ABORT: recompile with lzq=$',nzq)

Expand Down
75 changes: 31 additions & 44 deletions tests/nek5000_bps/bp3/bp3.usr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -445,7 +445,7 @@ c-----------------------------------------------------------------------

call opmask (e1,e2,e3)

call axhm3 (pap,r1,r2,r3,e1,e2,e3,h1,h2,'bp4')
call axhm3 (pap,r1,r2,r3,e1,e1,e2,h1,h2,'bp4')
call opdssum (r1,r2,r3)
call opmask (r1,r2,r3)

Expand All @@ -471,7 +471,7 @@ c-----------------------------------------------------------------------

nio = nid
nx = nx1-1
ndof = nelgt ! ndofs
ndof = ldim*nelgt ! ndofs
ndof = ndof*(nx**ldim)
nppp = ndof/np ! ndofs/proc

Expand Down Expand Up @@ -537,6 +537,7 @@ c-----------------------------------------------------------------------
tstart = dnekclock()
call cggos(u1,r1,e1,vmult,binvm1,tol,maxit,'bp3')
tstop = dnekclock()

telaps = (tstop-tstart)
maxits = maxit

Expand All @@ -563,9 +564,9 @@ c-----------------------------------------------------------------------
include 'CTIMER' ! ifsync
include 'FDMH1'

parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2))
real gf(lg,lx,lelt) ! Equivalence new gf() data
equivalence (gf,g1m1) ! layout to g1m1...g6m1
parameter (lzq=lx1+1)
parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2),lq=lzq**ldim)
common /bpgfactors/ gf(lg*lq,lelt),bmq(lq,lelt),w3mq(lq)

parameter (lt=lx1*ly1*lz1*lelt)
parameter (ld=lxd*lyd*lzd*lelt)
Expand All @@ -576,21 +577,20 @@ c-----------------------------------------------------------------------
logical ifh3
integer*8 ndof

call geodat1n ! Set up gf() arrays

ifsync = .false.

n = nx1*ny1*nz1*nelt
nzq = nx1+1
ifield = 1
n = nx1*ny1*nz1*nelt

call geodatq (gf,bmq,w3mq,nzq)
call rand_fld_h1(e1)

call copy (e2,e1,n)
call copy (e3,e1,n)
call copy (e2,e1,n)
call copy (e3,e1,n)

nxq = nx1+1
call set_h2_as_rhoJac_GL (h2,nxq)
call copy (h1,e1,n) ! Save exact soln in h1
call set_h2_as_rhoJac_GL (h2,bmq,nzq)
call copy (h1,e1,n) ! Save exact soln in h1

call axhm3 (pap,r1,r2,r3,e1,e2,e3,h1,h2,'bp2')
call vec_dssum (r1,r2,r3,nx1,ny1,nz1)
Expand Down Expand Up @@ -657,9 +657,9 @@ c-----------------------------------------------------------------------
include 'CTIMER' ! ifsync
include 'FDMH1'

parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2))
real gf(lg,lx,lelt) ! Equivalence new gf() data
equivalence (gf,g1m1) ! layout to g1m1...g6m1
parameter (lzq=lx1+1)
parameter (lx=lx1*ly1*lz1,lg=3+3*(ldim-2),lq=lzq**ldim)
common /bpgfactors/ gf(lg*lq,lelt),bmq(lq,lelt),w3mq(lq)

parameter (lt=lx1*ly1*lz1*lelt)
parameter (ld=lxd*lyd*lzd*lelt)
Expand All @@ -670,21 +670,20 @@ c-----------------------------------------------------------------------
logical ifh3
integer*8 ndof

call geodat1n ! Set up gf() arrays

ifsync = .false.

n = nx1*ny1*nz1*nelt
nzq = nx1+1
ifield = 1
n = nx1*ny1*nz1*nelt

call geodatq (gf,bmq,w3mq,nzq)
call rand_fld_h1(e1)

call copy (e2,e1,n)
call copy (e3,e1,n)
call copy (e2,e1,n)
call copy (e3,e1,n)

nxq = nx1+1
call set_h2_as_rhoJac_GL (h2,nxq)
call copy (h1,e1,n) ! Save exact soln in h1
call set_h2_as_rhoJac_GL (h2,bmq,nzq)
call copy (h1,e1,n) ! Save exact soln in h1

call axhm3 (pap,r1,r2,r3,e1,e2,e3,h1,h2,'bp2')
call vec_dssum (r1,r2,r3,nx1,ny1,nz1)
Expand Down Expand Up @@ -779,31 +778,19 @@ c-----------------------------------------------------------------------
return
end
c-----------------------------------------------------------------------
subroutine set_h2_as_rhoJac_GL(h2,nxq)
subroutine set_h2_as_rhoJac_GL(h2,bmq,nxq)
include 'SIZE'
real h2(1)

common /ctmp77/ wd(lxd),zd(lxd)
integer e

call zwgl(zd,wd,nxq) ! nxq = number of points
real h2(1),bmq(1)

integer i,lq

q = 1.0 ! Later, this can be a function of position...

L=0
do e=1,nelt
do k=1,nxq
do j=1,nxq
do i=1,nxq
L=L+1
h2(L) = q*wd(i)*wd(j)*wd(k)
enddo
enddo
enddo
enddo

lq = nxq**ldim*nelt

do i=1,lq
h2(i) = q*bmq(i)
enddo
return
end
c-----------------------------------------------------------------------
Expand Down Expand Up @@ -965,7 +952,6 @@ c (Gauss-Legendre Lobatto mesh).

real gf(lg,nzq**ldim,lelt),bmq(nzq**ldim,lelt),w3mq(nzq,nzq,nzq)

common /ctmp0/ tmp(lxyd)
common /ctmp1/ xr(lxyd),xs(lxyd),xt(lxyd)
common /sxrns/ yr(lxyd),ys(lxyd),yt(lxyd)
$ , zr(lxyd),zs(lxyd),zt(lxyd)
Expand All @@ -975,6 +961,7 @@ c (Gauss-Legendre Lobatto mesh).

integer e
real jacmq
real tmp(lxyd)

if (nzq.gt.lzq) call exitti('ABORT: recompile with lzq=$',nzq)

Expand Down
Loading