geometry_logspherical.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: geometry_logspherical.f90 #
5!# #
6!# Copyright (C) 2007-2018 #
7!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de> #
8!# Jannes Klee <jklee@astrophysik.uni-kiel.de> #
9!# #
10!# This program is free software; you can redistribute it and/or modify #
11!# it under the terms of the GNU General Public License as published by #
12!# the Free Software Foundation; either version 2 of the License, or (at #
13!# your option) any later version. #
14!# #
15!# This program is distributed in the hope that it will be useful, but #
16!# WITHOUT ANY WARRANTY; without even the implied warranty of #
17!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
18!# NON INFRINGEMENT. See the GNU General Public License for more #
19!# details. #
20!# #
21!# You should have received a copy of the GNU General Public License #
22!# along with this program; if not, write to the Free Software #
23!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
24!# #
25!#############################################################################
26
27!----------------------------------------------------------------------------!
32!----------------------------------------------------------------------------!
36 USE common_dict
37 IMPLICIT NONE
38 !--------------------------------------------------------------------------!
40 CONTAINS
42 PROCEDURE :: scalefactors_1
43 PROCEDURE :: scalefactors_2
44 PROCEDURE :: scalefactors_3
45 PROCEDURE :: scalefactors_4
46 PROCEDURE :: radius_1
47 PROCEDURE :: radius_2
48 PROCEDURE :: radius_3
49 PROCEDURE :: radius_4
50 PROCEDURE :: positionvector_1
51 PROCEDURE :: positionvector_2
52 PROCEDURE :: positionvector_3
53 PROCEDURE :: positionvector_4
62 PROCEDURE :: finalize
63 END TYPE
64 PRIVATE
65 CHARACTER(LEN=32), PARAMETER :: geometry_name = "logspherical"
66 !--------------------------------------------------------------------------!
67 PUBLIC :: geometry_logspherical
68 !--------------------------------------------------------------------------!
69
70CONTAINS
71
72 SUBROUTINE initgeometry_logspherical(this,config)
73 IMPLICIT NONE
74 !------------------------------------------------------------------------!
75 CLASS(geometry_logspherical), INTENT(INOUT) :: this
76 TYPE(dict_typ),POINTER :: config
77 !------------------------------------------------------------------------!
78 REAL :: gparam
79 !------------------------------------------------------------------------!
80 CALL getattr(config, "gparam", gparam, 1.0)
81
82 CALL this%SetScale(gparam)
83 CALL this%InitGeometry(logspherical,geometry_name,config)
84 CALL this%SetAzimuthIndex(3)
85 END SUBROUTINE initgeometry_logspherical
86
87 PURE SUBROUTINE scalefactors_1(this,coords,hx,hy,hz)
88 IMPLICIT NONE
89 !------------------------------------------------------------------------!
90 CLASS(geometry_logspherical), INTENT(IN) :: this
91 REAL, INTENT(IN), DIMENSION(:,:) :: coords
92 REAL, INTENT(OUT), DIMENSION(:) :: hx,hy,hz
93 !------------------------------------------------------------------------!
94 CALL scalefactors(this%geoparam(1),coords(:,1),coords(:,2),coords(:,3), &
95 hx(:),hy(:),hz(:))
96 END SUBROUTINE scalefactors_1
97
98 PURE SUBROUTINE scalefactors_2(this,coords,hx,hy,hz)
99 IMPLICIT NONE
100 !------------------------------------------------------------------------!
101 CLASS(geometry_logspherical), INTENT(IN) :: this
102 REAL, INTENT(IN), DIMENSION(:,:,:) :: coords
103 REAL, INTENT(OUT), DIMENSION(:,:) :: hx,hy,hz
104 !------------------------------------------------------------------------!
105 CALL scalefactors(this%geoparam(1),coords(:,:,1),coords(:,:,2), &
106 coords(:,:,3),hx(:,:),hy(:,:),hz(:,:))
107 END SUBROUTINE scalefactors_2
108
109 PURE SUBROUTINE scalefactors_3(this,coords,hx,hy,hz)
110 IMPLICIT NONE
111 !------------------------------------------------------------------------!
112 CLASS(geometry_logspherical), INTENT(IN) :: this
113 REAL, INTENT(IN), DIMENSION(:,:,:,:) :: coords
114 REAL, INTENT(OUT), DIMENSION(:,:,:) :: hx,hy,hz
115 !------------------------------------------------------------------------!
116 CALL scalefactors(this%geoparam(1),coords(:,:,:,1),coords(:,:,:,2), &
117 coords(:,:,:,3),hx(:,:,:),hy(:,:,:),hz(:,:,:))
118 END SUBROUTINE scalefactors_3
119
120 PURE SUBROUTINE scalefactors_4(this,coords,hx,hy,hz)
121 IMPLICIT NONE
122 !------------------------------------------------------------------------!
123 CLASS(geometry_logspherical), INTENT(IN) :: this
124 REAL, INTENT(IN), DIMENSION(:,:,:,:,:) :: coords
125 REAL, INTENT(OUT), DIMENSION(:,:,:,:) :: hx,hy,hz
126 !------------------------------------------------------------------------!
127 CALL scalefactors(this%geoparam(1),coords(:,:,:,:,1),coords(:,:,:,:,2), &
128 coords(:,:,:,:,3),hx(:,:,:,:),hy(:,:,:,:),hz(:,:,:,:))
129 END SUBROUTINE scalefactors_4
130
131 PURE SUBROUTINE radius_1(this,coords,r)
132 IMPLICIT NONE
133 !------------------------------------------------------------------------!
134 CLASS(geometry_logspherical), INTENT(IN) :: this
135 REAL, DIMENSION(:,:), INTENT(IN) :: coords
136 REAL, DIMENSION(:), INTENT(OUT) :: r
137 !------------------------------------------------------------------------!
138 r = radius(this%geoparam(1),coords(:,1))
139 END SUBROUTINE radius_1
140
141 PURE SUBROUTINE radius_2(this,coords,r)
142 IMPLICIT NONE
143 !------------------------------------------------------------------------!
144 CLASS(geometry_logspherical), INTENT(IN) :: this
145 REAL, DIMENSION(:,:,:), INTENT(IN) :: coords
146 REAL, DIMENSION(:,:), INTENT(OUT) :: r
147 !------------------------------------------------------------------------!
148 r = radius(this%geoparam(1),coords(:,:,1))
149 END SUBROUTINE radius_2
150
151 PURE SUBROUTINE radius_3(this,coords,r)
152 IMPLICIT NONE
153 !------------------------------------------------------------------------!
154 CLASS(geometry_logspherical), INTENT(IN) :: this
155 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: coords
156 REAL, DIMENSION(:,:,:), INTENT(OUT) :: r
157 !------------------------------------------------------------------------!
158 r = radius(this%geoparam(1),coords(:,:,:,1))
159 END SUBROUTINE radius_3
160
161 PURE SUBROUTINE radius_4(this,coords,r)
162 IMPLICIT NONE
163 !------------------------------------------------------------------------!
164 CLASS(geometry_logspherical), INTENT(IN) :: this
165 REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: coords
166 REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: r
167 !------------------------------------------------------------------------!
168 r = radius(this%geoparam(1),coords(:,:,:,:,1))
169 END SUBROUTINE radius_4
170
171 PURE SUBROUTINE positionvector_1(this,coords,posvec)
172 IMPLICIT NONE
173 !------------------------------------------------------------------------!
174 CLASS(geometry_logspherical), INTENT(IN) :: this
175 REAL, DIMENSION(:,:), INTENT(IN) :: coords
176 REAL, DIMENSION(:,:), INTENT(OUT) :: posvec
177 !------------------------------------------------------------------------!
178 CALL positionvector(this%geoparam(1),coords(:,1),posvec(:,1), &
179 posvec(:,2),posvec(:,3))
180 END SUBROUTINE positionvector_1
181
182 PURE SUBROUTINE positionvector_2(this,coords,posvec)
183 IMPLICIT NONE
184 !------------------------------------------------------------------------!
185 CLASS(geometry_logspherical), INTENT(IN) :: this
186 REAL, DIMENSION(:,:,:), INTENT(IN) :: coords
187 REAL, DIMENSION(:,:,:), INTENT(OUT) :: posvec
188 !------------------------------------------------------------------------!
189 CALL positionvector(this%geoparam(1),coords(:,:,1),posvec(:,:,1), &
190 posvec(:,:,2),posvec(:,:,3))
191 END SUBROUTINE positionvector_2
192
193 PURE SUBROUTINE positionvector_3(this,coords,posvec)
194 IMPLICIT NONE
195 !------------------------------------------------------------------------!
196 CLASS(geometry_logspherical), INTENT(IN) :: this
197 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: coords
198 REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: posvec
199 !------------------------------------------------------------------------!
200 CALL positionvector(this%geoparam(1),coords(:,:,:,1),posvec(:,:,:,1), &
201 posvec(:,:,:,2),posvec(:,:,:,3))
202 END SUBROUTINE positionvector_3
203
204 PURE SUBROUTINE positionvector_4(this,coords,posvec)
205 IMPLICIT NONE
206 !------------------------------------------------------------------------!
207 CLASS(geometry_logspherical), INTENT(IN) :: this
208 REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: coords
209 REAL, DIMENSION(:,:,:,:,:), INTENT(OUT) :: posvec
210 !------------------------------------------------------------------------!
211 CALL positionvector(this%geoparam(1),coords(:,:,:,:,1),posvec(:,:,:,:,1), &
212 posvec(:,:,:,:,2),posvec(:,:,:,:,3))
213 END SUBROUTINE positionvector_4
214
215 PURE SUBROUTINE convert2cartesian_coords_1(this,curv,cart)
216 IMPLICIT NONE
217 !------------------------------------------------------------------------!
218 CLASS(geometry_logspherical), INTENT(IN) :: this
219 REAL, DIMENSION(:,:), INTENT(IN) :: curv
220 REAL, DIMENSION(:,:), INTENT(OUT) :: cart
221 !------------------------------------------------------------------------!
222 CALL convert2cartesian_coords(this%geoparam(1),curv(:,1),curv(:,2),curv(:,3), &
223 cart(:,1),cart(:,2),cart(:,3))
224 END SUBROUTINE convert2cartesian_coords_1
225
226 PURE SUBROUTINE convert2cartesian_coords_2(this,curv,cart)
227 IMPLICIT NONE
228 !------------------------------------------------------------------------!
229 CLASS(geometry_logspherical), INTENT(IN) :: this
230 REAL, DIMENSION(:,:,:), INTENT(IN) :: curv
231 REAL, DIMENSION(:,:,:), INTENT(OUT) :: cart
232 !------------------------------------------------------------------------!
233 CALL convert2cartesian_coords(this%geoparam(1),curv(:,:,1),curv(:,:,2),curv(:,:,3), &
234 cart(:,:,1),cart(:,:,2),cart(:,:,3))
235 END SUBROUTINE convert2cartesian_coords_2
236
237 PURE SUBROUTINE convert2cartesian_coords_3(this,curv,cart)
238 IMPLICIT NONE
239 !------------------------------------------------------------------------!
240 CLASS(geometry_logspherical), INTENT(IN) :: this
241 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: curv
242 REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: cart
243 !------------------------------------------------------------------------!
244 CALL convert2cartesian_coords(this%geoparam(1),curv(:,:,:,1),curv(:,:,:,2),curv(:,:,:,3), &
245 cart(:,:,:,1),cart(:,:,:,2),cart(:,:,:,3))
246 END SUBROUTINE convert2cartesian_coords_3
247
248 PURE SUBROUTINE convert2cartesian_coords_4(this,curv,cart)
249 IMPLICIT NONE
250 !------------------------------------------------------------------------!
251 CLASS(geometry_logspherical), INTENT(IN) :: this
252 REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: curv
253 REAL, DIMENSION(:,:,:,:,:), INTENT(OUT) :: cart
254 !------------------------------------------------------------------------!
255 CALL convert2cartesian_coords(this%geoparam(1),curv(:,:,:,:,1),curv(:,:,:,:,2),curv(:,:,:,:,3), &
256 cart(:,:,:,:,1),cart(:,:,:,:,2),cart(:,:,:,:,3))
257 END SUBROUTINE convert2cartesian_coords_4
258
259 PURE SUBROUTINE convert2curvilinear_coords_1(this,cart,curv)
260 IMPLICIT NONE
261 !------------------------------------------------------------------------!
262 CLASS(geometry_logspherical), INTENT(IN) :: this
263 REAL, DIMENSION(:,:), INTENT(IN) :: cart
264 REAL, DIMENSION(:,:), INTENT(OUT) :: curv
265 !------------------------------------------------------------------------!
266 CALL convert2curvilinear_coords(this%geoparam(1),cart(:,1),cart(:,2),cart(:,3), &
267 curv(:,1),curv(:,2),curv(:,3))
268 END SUBROUTINE convert2curvilinear_coords_1
269
270 PURE SUBROUTINE convert2curvilinear_coords_2(this,cart,curv)
271 IMPLICIT NONE
272 !------------------------------------------------------------------------!
273 CLASS(geometry_logspherical), INTENT(IN) :: this
274 REAL, DIMENSION(:,:,:), INTENT(IN) :: cart
275 REAL, DIMENSION(:,:,:), INTENT(OUT) :: curv
276 !------------------------------------------------------------------------!
277 CALL convert2curvilinear_coords(this%geoparam(1),cart(:,:,1),cart(:,:,2),cart(:,:,3), &
278 curv(:,:,1),curv(:,:,2),curv(:,:,3))
279 END SUBROUTINE convert2curvilinear_coords_2
280
281 PURE SUBROUTINE convert2curvilinear_coords_3(this,cart,curv)
282 IMPLICIT NONE
283 !------------------------------------------------------------------------!
284 CLASS(geometry_logspherical), INTENT(IN) :: this
285 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: cart
286 REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: curv
287 !------------------------------------------------------------------------!
288 CALL convert2curvilinear_coords(this%geoparam(1),cart(:,:,:,1),cart(:,:,:,2),cart(:,:,:,3), &
289 curv(:,:,:,1),curv(:,:,:,2),curv(:,:,:,3))
290 END SUBROUTINE convert2curvilinear_coords_3
291
292 PURE SUBROUTINE convert2curvilinear_coords_4(this,cart,curv)
293 IMPLICIT NONE
294 !------------------------------------------------------------------------!
295 CLASS(geometry_logspherical), INTENT(IN) :: this
296 REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: cart
297 REAL, DIMENSION(:,:,:,:,:), INTENT(OUT) :: curv
298 !------------------------------------------------------------------------!
299 CALL convert2curvilinear_coords(this%geoparam(1),cart(:,:,:,:,1),cart(:,:,:,:,2),cart(:,:,:,:,3), &
300 curv(:,:,:,:,1),curv(:,:,:,:,2),curv(:,:,:,:,3))
301 END SUBROUTINE convert2curvilinear_coords_4
302
304 ELEMENTAL SUBROUTINE convert2cartesian_vectors_0(this,xi,eta,phi,vxi,veta,vphi,vx,vy,vz)
305 IMPLICIT NONE
306 !------------------------------------------------------------------------!
307 CLASS(geometry_logspherical), INTENT(IN) :: this
308 REAL, INTENT(IN) :: xi,eta,phi,vxi,veta,vphi
309 REAL, INTENT(OUT) :: vx,vy,vz
310 !------------------------------------------------------------------------!
311 vx = vxi*sin(eta)*cos(phi) + veta*cos(eta)*cos(phi) - vphi*sin(phi)
312 vy = vxi*sin(eta)*sin(phi) + veta*cos(eta)*sin(phi) + vphi*cos(phi)
313 vz = vxi*cos(eta) - veta*sin(eta)
314 END SUBROUTINE convert2cartesian_vectors_0
315
317 ELEMENTAL SUBROUTINE convert2curvilinear_vectors_0(this,xi,eta,phi,vx,vy,vz,vxi,veta,vphi)
318 IMPLICIT NONE
319 !------------------------------------------------------------------------!
320 CLASS(geometry_logspherical), INTENT(IN) :: this
321 REAL, INTENT(IN) :: xi,eta,phi,vx,vy,vz
322 REAL, INTENT(OUT) :: vxi,veta,vphi
323 !------------------------------------------------------------------------!
324 vxi = vx*sin(eta)*cos(phi) + vy*sin(eta)*sin(phi) + vz*cos(eta)
325 veta = vx*cos(eta)*cos(phi) + vy*cos(eta)*sin(phi) - vz*sin(eta)
326 vphi = -vx*sin(phi) + vy*cos(phi)
327 END SUBROUTINE convert2curvilinear_vectors_0
328
329 SUBROUTINE finalize(this)
330 IMPLICIT NONE
331 !------------------------------------------------------------------------!
332 CLASS(geometry_logspherical), INTENT(INOUT) :: this
333 !------------------------------------------------------------------------!
334 CALL this%Finalize_base()
335 END SUBROUTINE finalize
336
337 ELEMENTAL SUBROUTINE scalefactors(gp,logr,theta,phi,hlogr,htheta,hphi)
338 IMPLICIT NONE
339 !------------------------------------------------------------------------!
340 REAL, INTENT(IN) :: gp,logr,theta,phi
341 REAL, INTENT(OUT) :: hlogr,htheta,hphi
342 !------------------------------------------------------------------------!
343 hlogr = gp*exp(logr)
344 htheta = hlogr
345 hphi = hlogr * sin(theta)
346 END SUBROUTINE scalefactors
347
348 ELEMENTAL FUNCTION radius(gp,logr)
349 IMPLICIT NONE
350 !------------------------------------------------------------------------!
351 REAL, INTENT(IN) :: gp,logr
352 REAL :: radius
353 !------------------------------------------------------------------------!
354 radius = gp*exp(logr)
355 END FUNCTION radius
356
357 ELEMENTAL SUBROUTINE positionvector(gp,logr,rx,ry,rz)
358 IMPLICIT NONE
359 !------------------------------------------------------------------------!
360 REAL, INTENT(IN) :: gp,logr
361 REAL, INTENT(OUT) :: rx,ry,rz
362 !------------------------------------------------------------------------!
363 rx = radius(gp,logr)
364 ry = 0.0
365 rz = 0.0
366 END SUBROUTINE positionvector
367
368 ELEMENTAL SUBROUTINE convert2cartesian_coords(gp,logr,theta,phi,x,y,z)
369 IMPLICIT NONE
370 !------------------------------------------------------------------------!
371 REAL, INTENT(IN) :: gp,logr,theta,phi
372 REAL, INTENT(OUT) :: x,y,z
373 !------------------------------------------------------------------------!
374 REAL :: r
375 !------------------------------------------------------------------------!
376 r = gp*exp(logr)
377 x = r*sin(theta)*cos(phi)
378 y = r*sin(theta)*sin(phi)
379 z = r*cos(theta)
380 END SUBROUTINE convert2cartesian_coords
381
382 ELEMENTAL SUBROUTINE convert2curvilinear_coords(gp,x,y,z,logr,theta,phi)
383 IMPLICIT NONE
384 !------------------------------------------------------------------------!
385 REAL, INTENT(IN) :: gp,x,y,z
386 REAL, INTENT(OUT) :: logr,theta,phi
387 !------------------------------------------------------------------------!
388 REAL :: r
389 !------------------------------------------------------------------------!
390 r = sqrt(x*x+y*y+z*z)
391 logr = log(r/gp)
392 theta = acos(z/r)
393 phi = atan2(y,x)
394 IF(phi.LT.0.0) THEN
395 phi = phi + 2.0*pi
396 END IF
397 END SUBROUTINE convert2curvilinear_coords
398
Dictionary for generic data types.
Definition: common_dict.f90:61
type(logging_base), save this
base class for geometrical properties
real, parameter, public pi
pure subroutine convert2curvilinear_coords(this, cart, curv)
Convert cartesian to curvilinear coordinates.
pure subroutine convert2cartesian_coords(this, curv, cart)
Convert curvilinear to cartesian coordinates.
integer, parameter, public logspherical
defines properties of a 3D logspherical mesh
pure subroutine radius_4(this, coords, r)
character(len=32), parameter geometry_name
pure subroutine radius_3(this, coords, r)
pure subroutine scalefactors_2(this, coords, hx, hy, hz)
elemental subroutine convert2curvilinear_vectors_0(this, xi, eta, phi, vx, vy, vz, vxi, veta, vphi)
Reference: , Tabelle 13.1.
pure subroutine convert2curvilinear_coords_4(this, cart, curv)
pure subroutine radius_1(this, coords, r)
pure subroutine convert2curvilinear_coords_2(this, cart, curv)
pure subroutine convert2cartesian_coords_2(this, curv, cart)
pure subroutine positionvector_2(this, coords, posvec)
pure subroutine positionvector_3(this, coords, posvec)
pure subroutine convert2cartesian_coords_1(this, curv, cart)
pure subroutine scalefactors_4(this, coords, hx, hy, hz)
pure subroutine scalefactors_1(this, coords, hx, hy, hz)
pure subroutine convert2cartesian_coords_3(this, curv, cart)
elemental subroutine convert2cartesian_vectors_0(this, xi, eta, phi, vxi, veta, vphi, vx, vy, vz)
Reference: , Tabelle 13.1.
pure subroutine convert2cartesian_coords_4(this, curv, cart)
elemental real function radius(gp, logr)
pure subroutine radius_2(this, coords, r)
pure subroutine positionvector_4(this, coords, posvec)
subroutine initgeometry_logspherical(this, config)
elemental subroutine scalefactors(gp, logr, theta, phi, hlogr, htheta, hphi)
pure subroutine scalefactors_3(this, coords, hx, hy, hz)
pure subroutine convert2curvilinear_coords_1(this, cart, curv)
pure subroutine convert2curvilinear_coords_3(this, cart, curv)
elemental subroutine positionvector(gp, logr, rx, ry, rz)
pure subroutine positionvector_1(this, coords, posvec)
defines properties of a 3D spherical mesh