• R/O
  • SSH

polynomials: コミット

Repository of the polynomials library.


コミットメタ情報

リビジョンd3c134059797f288e15d62d9fa77d236d916596c (tree)
日時2019-08-23 20:31:28
作者Daniel Fleischer <daniel.fleischer@stud...>
コミッターDaniel Fleischer

ログメッセージ

Added a subroutine which allows projection between P-space and Q-space in ply_dof_module.

変更サマリ

差分

diff -r fc902328e5b1 -r d3c134059797 source/ply_dof_module.f90
--- a/source/ply_dof_module.f90 Thu Aug 22 11:18:48 2019 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,98 +0,0 @@
1-! Copyright (c) 2012-2013 Jens Zudrop <j.zudrop@grs-sim.de>
2-! Copyright (c) 2012 Jan Hueckelheim <j.hueckelheim@grs-sim.de>
3-! Copyright (c) 2013-2014,2018 Harald Klimach <harald.klimach@uni-siegen.de>
4-! Copyright (c) 2013 Verena Krupp <verena.krupp@uni-siegen.de>
5-! Copyright (c) 2013 Melven Zoellner <yameta@freenet.de>
6-! Copyright (c) 2014,2016-2017 Peter Vitt <peter.vitt2@uni-siegen.de>
7-! Copyright (c) 2018 Daniel Fleischer <daniel.fleischer@student.uni-siegen.de>
8-! Copyright (c) 2016 Tobias Girresser <tobias.girresser@student.uni-siegen.de>
9-!
10-! Parts of this file were written by Jens Zudrop, Jan Hueckelheim, Melven
11-! Zoellner and Harald Klimach for German Research School for Simulation
12-! Sciences GmbH.
13-!
14-! Parts of this file were written by Harald Klimach, Verena Krupp, Peter Vitt,
15-! Daniel Fleischer and Tobias Girresser for University of Siegen.
16-!
17-! Permission to use, copy, modify, and distribute this software for any
18-! purpose with or without fee is hereby granted, provided that the above
19-! copyright notice and this permission notice appear in all copies.
20-!
21-! THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES
22-! WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
23-! MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR
24-! ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
25-! WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
26-! ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
27-! OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
28-! **************************************************************************** !
29-
30-!> Module provides subroutines, functions and datatypes regarding
31-!! cell local degrees of freedoms.
32-module ply_dof_module
33- use env_module, only: rk
34-
35- implicit none
36-
37- private
38-
39- public :: ply_dof_nextCoeff, ply_dof_pos, ply_dof_count, ply_dof_2degree
40-
41- abstract interface
42- subroutine ply_dof_nextCoeff(ansFuncX, ansFuncY, ansFuncZ, maxDegree)
43- integer, intent(inout) :: ansFuncX, ansFuncY, ansFuncZ
44- integer, intent(in) :: maxdegree
45- end subroutine ply_dof_nextCoeff
46-
47- function ply_dof_pos(ansFuncX, ansFuncY, ansFuncZ, maxDegree) result(pos)
48- integer, intent(in) :: ansFuncX, ansFuncY, ansFuncZ
49- integer, intent(in) :: maxdegree
50- integer :: pos
51- end function ply_dof_pos
52-
53- function ply_dof_count(maxPolyDegree) result(DoFs)
54- integer, intent(in) :: maxPolyDegree
55- integer :: DoFs
56- end function ply_dof_count
57- end interface
58-
59- !> Parameter to identify Q polynomials
60- integer, public, parameter :: Q_space = 1
61- !> Parameter to identify P polynomials
62- integer, public, parameter :: P_space = 2
63-
64-contains
65-
66- elemental function ply_dof_2degree(ndofs, space, ndims) result(deg)
67- integer, intent(in) :: ndofs
68- integer, intent(in) :: space
69- integer, intent(in) :: ndims
70- integer :: deg
71-
72- integer :: idim, fact, estimate
73-
74- select case(space)
75- case (Q_space)
76- deg = nint(ndofs**(1._rk/real(ndims,kind=rk))) - 1
77- case (P_space)
78- deg = 0
79- fact = 1
80- do idim=1,ndims
81- fact = fact*idim
82- end do
83- do
84- estimate = 1
85- do idim=1,ndims
86- estimate = estimate * (deg + idim)
87- end do
88- estimate = estimate/fact
89- if (estimate >= ndofs) then
90- deg = estimate
91- EXIT
92- end if
93- end do
94- end select
95-
96- end function ply_dof_2degree
97-
98-end module ply_dof_module
diff -r fc902328e5b1 -r d3c134059797 source/ply_dof_module.fpp
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/source/ply_dof_module.fpp Fri Aug 23 13:31:28 2019 +0200
@@ -0,0 +1,187 @@
1+! Copyright (c) 2012-2013 Jens Zudrop <j.zudrop@grs-sim.de>
2+! Copyright (c) 2012 Jan Hueckelheim <j.hueckelheim@grs-sim.de>
3+! Copyright (c) 2013-2014,2018 Harald Klimach <harald.klimach@uni-siegen.de>
4+! Copyright (c) 2013 Verena Krupp <verena.krupp@uni-siegen.de>
5+! Copyright (c) 2013 Melven Zoellner <yameta@freenet.de>
6+! Copyright (c) 2014,2016-2017 Peter Vitt <peter.vitt2@uni-siegen.de>
7+! Copyright (c) 2018 Daniel Fleischer <daniel.fleischer@student.uni-siegen.de>
8+! Copyright (c) 2016 Tobias Girresser <tobias.girresser@student.uni-siegen.de>
9+!
10+! Parts of this file were written by Jens Zudrop, Jan Hueckelheim, Melven
11+! Zoellner and Harald Klimach for German Research School for Simulation
12+! Sciences GmbH.
13+!
14+! Parts of this file were written by Harald Klimach, Verena Krupp, Peter Vitt,
15+! Daniel Fleischer and Tobias Girresser for University of Siegen.
16+!
17+! Permission to use, copy, modify, and distribute this software for any
18+! purpose with or without fee is hereby granted, provided that the above
19+! copyright notice and this permission notice appear in all copies.
20+!
21+! THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES
22+! WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
23+! MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR
24+! ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
25+! WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
26+! ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
27+! OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
28+! **************************************************************************** !
29+
30+?? include 'polynomials/source/ply_dof_module.inc'
31+!> Module provides subroutines, functions and datatypes regarding
32+!! cell local degrees of freedoms.
33+module ply_dof_module
34+ use env_module, only: rk
35+
36+ implicit none
37+
38+ private
39+
40+ public :: ply_dof_nextCoeff, ply_dof_pos, ply_dof_count, ply_dof_2degree, &
41+ & ply_degree_2dof, ply_change_poly_space
42+
43+ abstract interface
44+ subroutine ply_dof_nextCoeff(ansFuncX, ansFuncY, ansFuncZ, maxDegree)
45+ integer, intent(inout) :: ansFuncX, ansFuncY, ansFuncZ
46+ integer, intent(in) :: maxdegree
47+ end subroutine ply_dof_nextCoeff
48+
49+ function ply_dof_pos(ansFuncX, ansFuncY, ansFuncZ, maxDegree) result(pos)
50+ integer, intent(in) :: ansFuncX, ansFuncY, ansFuncZ
51+ integer, intent(in) :: maxdegree
52+ integer :: pos
53+ end function ply_dof_pos
54+
55+ function ply_dof_count(maxPolyDegree) result(DoFs)
56+ integer, intent(in) :: maxPolyDegree
57+ integer :: DoFs
58+ end function ply_dof_count
59+ end interface
60+
61+ !> Parameter to identify Q polynomials
62+ integer, public, parameter :: Q_space = 1
63+ !> Parameter to identify P polynomials
64+ integer, public, parameter :: P_space = 2
65+
66+contains
67+
68+ elemental function ply_dof_2degree(ndofs, space, ndims) result(deg)
69+ integer, intent(in) :: ndofs
70+ integer, intent(in) :: space
71+ integer, intent(in) :: ndims
72+ integer :: deg
73+
74+ integer :: idim, fact, estimate
75+
76+ select case(space)
77+ case (Q_space)
78+ deg = nint(ndofs**(1._rk/real(ndims,kind=rk))) - 1
79+ case (P_space)
80+ deg = 0
81+ do
82+ estimate = ply_degree_2dof(deg, space, nDims)
83+ if (estimate >= ndofs) then
84+ EXIT
85+ end if
86+ deg = deg + 1
87+ end do
88+ end select
89+
90+ end function ply_dof_2degree
91+
92+ elemental function ply_degree_2dof(deg, space, nDims) result(nDofs)
93+ integer, intent(in) :: deg
94+ integer, intent(in) :: space
95+ integer, intent(in) :: nDims
96+ integer :: nDofs
97+
98+ select case(space)
99+ case (Q_space)
100+ nDofs = (deg+1)**nDims
101+ case (P_space)
102+ select case (nDims)
103+ case(3)
104+ nDofs = ((deg + 1) &
105+ & * (deg + 2) &
106+ & * (deg + 3)) &
107+ & / 6
108+ case(2)
109+ nDofs = ((deg + 1) &
110+ & * (deg + 2)) &
111+ & / 3
112+ case(1)
113+ nDofs = (deg + 1)
114+ end select
115+ end select
116+
117+ end function ply_degree_2dof
118+
119+ !> Subroutine to change the polynomial space (Q or P) of an
120+ !! atl_statedata_type from Q-space to P-space and vice versa.
121+ ! The space of the instate (inspace) defines the space of the
122+ ! outstate.
123+ subroutine ply_change_poly_space( inspace, instate, outstate, &
124+ & maxPolyDeg, nElems, nVars )
125+ ! -------------------------------------------------------------------- !
126+ !> Polynomial space of the input state (P_sapce or Q_space)
127+ integer, intent(in) :: inspace
128+
129+ !> States of the variables of the input in polynomial space as
130+ !! prescribed in inspace.
131+ real(kind=rk), allocatable, intent(in) :: instate(:,:,:)
132+
133+ !> States of the variables of the output.
134+ real(kind=rk), allocatable, intent(inout) :: outstate(:,:,:)
135+
136+ integer, intent(in) :: maxPolyDeg
137+
138+ integer, intent(in) :: nElems
139+
140+ integer, intent(in) :: nVars
141+ ! -------------------------------------------------------------------- !
142+ integer :: iElem, iVar, iAnsX, iAnsY, iAnsZ
143+ integer :: P_pos, Q_pos
144+ ! -------------------------------------------------------------------- !
145+ select case(inspace)
146+ ! Instate space is P_space so outstate space is Q_space
147+ ! Copy the dofs in the right order and fill up the higher modes with zeros
148+ case(P_space)
149+ outstate = 0.0_rk
150+ do iElem = 1, nElems
151+ do iVar = 1, nVars
152+ do iAnsZ = 1, maxPolyDeg+1
153+ do iAnsY = 1, maxPolyDeg+1 - (iAnsZ-1)
154+ do iAnsX = 1, maxPolyDeg+1 - (iAnsZ-1) - (iAnsY-1)
155+?? copy :: posOfModgCoeffPTens(iAnsX, iAnsY, iAnsZ, P_pos)
156+?? copy :: posOfModgCoeffQTens(iAnsX, iAnsY, iAnsZ, maxPolyDeg, Q_pos)
157+ outstate( iElem, Q_pos, iVar ) = instate(iElem, P_pos, iVar)
158+ end do
159+ end do
160+ end do
161+ end do
162+ end do
163+
164+ ! Instate space is Q_space so outstate space is P_space
165+ ! Copy the dofs in the right order and cut off the higher modes
166+ case(Q_space)
167+
168+ do iElem = 1, nElems
169+ do iVar = 1, nVars
170+ do iAnsZ = 1, maxPolyDeg+1
171+ do iAnsY = 1, maxPolyDeg+1 - (iAnsZ-1)
172+ do iAnsX = 1, maxPolyDeg+1 - (iAnsZ-1) - (iAnsY-1)
173+?? copy :: posOfModgCoeffPTens(iAnsX, iAnsY, iAnsZ, P_pos)
174+?? copy :: posOfModgCoeffQTens(iAnsX, iAnsY, iAnsZ, maxPolyDeg, Q_pos)
175+ outstate( iElem, P_pos, iVar ) = instate(iElem, Q_pos, iVar)
176+ end do
177+ end do
178+ end do
179+ end do
180+ end do
181+
182+
183+ end select
184+
185+ end subroutine ply_change_poly_space
186+
187+end module ply_dof_module
旧リポジトリブラウザで表示