pringle.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: pringle.f90 #
5!# #
6!# Copyright (C) 2008-2024 #
7!# Bjoern Sperling <sperling@astrophysik.uni-kiel.de> #
8!# Tobias Illenseer <tillense@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!----------------------------------------------------------------------------!
47!----------------------------------------------------------------------------!
49 USE fosite_mod
50 USE common_dict
51#include "tap.h"
52 IMPLICIT NONE
53 !--------------------------------------------------------------------------!
54 ! simulation parameters
55 REAL, PARAMETER :: tsim = 2.0e-2 ! simulation time [TVIS] see below
56 ! should be < 1 ~ viscous time scale
57 ! these are the basic parameters; for stable solutions one requires
58 ! MA >> 1 and RE > MA
59 REAL, PARAMETER :: re = 1.0e+4 ! Reynolds number (at R=1)
60 REAL, PARAMETER :: ma = 1.0e+2 ! Mach number (at R=1)
61 REAL, PARAMETER :: mdisk = 1.0e-2 ! disk mass << 1 = central mass
62 ! lower limit for nitial density
63 REAL, PARAMETER :: rhomin = 1.0e-20 ! minimal initial density
64 ! viscosity prescription
65! INTEGER, PARAMETER :: VISTYPE = BETA
66 INTEGER, PARAMETER :: vistype = powerlaw
67 REAL, PARAMETER :: pl_exp = 0.0 ! exponent for power law viscosity
68 REAL, PARAMETER :: tvis = 4./3.*re ! viscous time scale
69 REAL, PARAMETER :: tinit = 1.0e-3 ! time for initial condition [TVIS]
70 ! mesh settings
71 !**************************************************************************!
79 !**************************************************************************!
80 INTEGER, PARAMETER :: mgeo = cylindrical
81! INTEGER, PARAMETER :: MGEO = LOGCYLINDRICAL
82! INTEGER, PARAMETER :: MGEO = SPHERICAL !!! ATTENTION: not applicable in 1D
83 INTEGER, PARAMETER :: xres = 400 ! x-resolution
84 INTEGER, PARAMETER :: yres = 1 ! y-resolution
85 INTEGER, PARAMETER :: zres = 1 ! z-resolution
86 REAL, PARAMETER :: rmin = 0.05 ! min radius of comp. domain
87 REAL, PARAMETER :: rmax = 2.0 ! max radius of comp. domain
88 REAL, PARAMETER :: gpar = 1.0 ! geometry scaling parameter
89 ! output parameters
90 INTEGER, PARAMETER :: onum = 10 ! number of output data sets
91 CHARACTER(LEN=256), PARAMETER & ! output data dir
92 :: odir = './'
93 CHARACTER(LEN=256), PARAMETER & ! output data file name
94 :: ofname = 'pringle'
95 ! derived parameters
96 REAL, PARAMETER :: csiso = 1./ma ! isothermal speed of sound
97 REAL :: x0 = 0.0 ! cartesian position of point
98 REAL :: y0 = 0.0 ! mass (default: origin)
99 REAL :: z0 = 0.0 !
100 !--------------------------------------------------------------------------!
101 CLASS(fosite), ALLOCATABLE :: sim
102 REAL, DIMENSION(:), ALLOCATABLE :: sigma
103 REAL :: sum_numer, sum_denom
104 INTEGER :: n,den,vx,vy
105 REAL :: next_output_time
106 INTEGER :: i,j,k
107 LOGICAL :: ok
108 !--------------------------------------------------------------------------!
109
110 ALLOCATE(sim)
111 CALL sim%InitFosite()
112
113#ifdef PARALLEL
114 IF (sim%GetRank().EQ.0) THEN
115#endif
116#ifdef HAVE_FGSL
117tap_plan(4)
118#else
119tap_plan(1)
120#endif
121#ifdef PARALLEL
122 END IF
123#endif
124
125 CALL makeconfig(sim, sim%config)
126 CALL sim%Setup()
127 CALL initdata(sim,sim%Mesh, sim%Physics, sim%Timedisc, sim%Sources)
128 next_output_time = sim%Datafile%time
129 IF (ASSOCIATED(sim%Timedisc%solution)) THEN
130#ifdef HAVE_FGSL
131 DO WHILE((sim%Timedisc%maxiter.LE.0).OR.(sim%iter.LE.sim%Timedisc%maxiter))
132 ! advance numerical solution
133 IF(sim%Step()) EXIT
134 IF (next_output_time.LT.sim%Datafile%time) THEN
135 ! compute exact solution for next output time step
136 next_output_time = sim%Datafile%time
137 SELECT TYPE(pvar => sim%Timedisc%solution)
138 TYPE IS (statevector_eulerisotherm)
139 k=sim%Mesh%KMIN
140 DO j=sim%Mesh%JMIN,sim%Mesh%JMAX
141 DO i=sim%Mesh%IMIN,sim%Mesh%IMAX
142 IF (vistype.EQ.beta) THEN
143 CALL viscousring_analytic(1.0,next_output_time/tvis+tinit, &
144 sim%Mesh%radius%bcenter(i,j,k), &
145 pvar%density%data3d(i,j,k),pvar%velocity%data4d(i,j,k,1))
146 ELSE
147 CALL viscousring_analytic(pl_exp,next_output_time/tvis+tinit, &
148 sim%Mesh%radius%bcenter(i,j,k), &
149 pvar%density%data3d(i,j,k),pvar%velocity%data4d(i,j,k,1))
150 END IF
151 END DO
152 END DO
153 END SELECT
154 END IF
155 END DO
156#else
157 CALL sim%Error("pringle","computation of analytical solution requires GSL support")
158#endif
159 ELSE
160 CALL sim%Run()
161 END IF
162 ok = .NOT.sim%aborted
163 ALLOCATE(sigma(sim%Physics%VNUM))
164 ! compare with exact solution if requested
165 IF (ASSOCIATED(sim%Timedisc%solution)) THEN
166 DO n=1,sim%Physics%VNUM
167 ! use L1 norm to estimate the deviation from the exact solution:
168 ! Σ |pvar - pvar_exact| / Σ |pvar_exact|
169 sum_numer = sum(abs(sim%Timedisc%pvar%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,&
170 sim%Mesh%JMIN:sim%Mesh%JMAX,sim%Mesh%KMIN:sim%Mesh%KMAX,n) &
171 -sim%Timedisc%solution%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,&
172 sim%Mesh%JMIN:sim%Mesh%JMAX,sim%Mesh%KMIN:sim%Mesh%KMAX,n)))
173 sum_denom = sum(abs(sim%Timedisc%solution%data4d(sim%Mesh%IMIN:sim%Mesh%IMAX,&
174 sim%Mesh%JMIN:sim%Mesh%JMAX,sim%Mesh%KMIN:sim%Mesh%KMAX,n)))
175#ifdef PARALLEL
176 IF (sim%GetRank().GT.0) THEN
177 CALL mpi_reduce(sum_numer,sum_numer,1,default_mpi_real,mpi_sum,0,mpi_comm_world,sim%ierror)
178 CALL mpi_reduce(sum_denom,sum_denom,1,default_mpi_real,mpi_sum,0,mpi_comm_world,sim%ierror)
179 ELSE
180 CALL mpi_reduce(mpi_in_place,sum_numer,1,default_mpi_real,mpi_sum,0,mpi_comm_world,sim%ierror)
181 CALL mpi_reduce(mpi_in_place,sum_denom,1,default_mpi_real,mpi_sum,0,mpi_comm_world,sim%ierror)
182#endif
183 sigma(n) = sum_numer / sum_denom
184#ifdef PARALLEL
185 END IF
186#endif
187 END DO
188 ELSE
189 sigma(:) = 0.0
190 END IF
191
192 den = sim%Physics%DENSITY
193 vx = sim%Physics%XVELOCITY
194 vy = sim%Physics%YVELOCITY
195
196#ifdef PARALLEL
197 IF (sim%GetRank().EQ.0) THEN
198#endif
199tap_check(ok,"stoptime reached")
200! These lines are very long if expanded. So we can't indent it or it will be cropped.
201#ifdef HAVE_FGSL
202tap_check_small(sigma(den),5.0e-02,"density deviation < 5%")
203tap_check_small(sigma(vx),9.0e-02,"radial velocity deviation < 9%")
204tap_check_small(sigma(vy),2.0e-04,"azimuthal velocity deviation < 0.02%")
205#endif
206tap_done
207#ifdef PARALLEL
208 END IF
209#endif
210
211 IF (ALLOCATED(sigma)) DEALLOCATE(sigma)
212 CALL sim%Finalize()
213 DEALLOCATE(sim)
214
215CONTAINS
216
217 SUBROUTINE makeconfig(Sim, config)
218 USE functions, ONLY : asinh
219 IMPLICIT NONE
220 !------------------------------------------------------------------------!
221 CLASS(fosite) :: Sim
222 TYPE(dict_typ),POINTER :: config
223 !------------------------------------------------------------------------!
224 ! Local variable declaration
225 INTEGER :: bc(6)
226 TYPE(dict_typ), POINTER :: mesh, physics, boundary, datafile, &
227 grav, vis, timedisc, fluxes, sources
228 REAL :: x1,x2,y1,y2,z1,z2,cvis
229 !------------------------------------------------------------------------!
230 INTENT(INOUT) :: sim
231 !------------------------------------------------------------------------!
232 ! mesh settings and boundary conditions
233 SELECT CASE(mgeo)
234 CASE(cylindrical)
235 x1 = rmin
236 x2 = rmax
237 y1 = -pi
238 y2 = pi
239 z1 = 0.0
240 z2 = 0.0
241! bc(WEST) = NO_GRADIENTS
242! bc(EAST) = NO_GRADIENTS
243! bc(WEST) = ABSORBING
244! bc(EAST) = ABSORBING
245 bc(west) = custom
246 bc(east) = custom
247 bc(south) = periodic
248 bc(north) = periodic
249 bc(bottom) = no_gradients
250 bc(top) = no_gradients
251 cvis = 0.3
252 CASE(logcylindrical)
253 x1 = log(rmin/gpar)
254 x2 = log(rmax/gpar)
255 y1 = -pi
256 y2 = pi
257 z1 = 0.0
258 z2 = 0.0
259 bc(west) = no_gradients
260 bc(east) = no_gradients
261 bc(south) = periodic
262 bc(north) = periodic
263 bc(bottom) = no_gradients
264 bc(top) = no_gradients
265 cvis = 0.3
266 CASE(spherical)
267 x1 = rmin
268 x2 = rmax
269 y1 = pi/2 ! - 0.05*PI
270 y2 = pi/2 ! + 0.05*PI
271 z1 = -pi
272 z2 = pi
273! bc(WEST) = NO_GRADIENTS
274! bc(EAST) = NO_GRADIENTS
275 bc(west) = custom
276 bc(east) = custom
277 bc(south) = no_gradients
278 bc(north) = no_gradients
279 bc(bottom) = periodic
280 bc(top) = periodic
281 cvis = 0.3
282 CASE DEFAULT
283 CALL sim%Error("pringle::MakeConfig","mesh geometry not supported for Pringle disk")
284 END SELECT
285
286 ! mesh settings
287 mesh => dict( &
288 "meshtype" / midpoint, &
289 "geometry" / mgeo, &
290 "inum" / xres, &
291 "jnum" / yres, &
292 "knum" / zres, &
293 "xmin" / x1, &
294 "xmax" / x2, &
295 "ymin" / y1, &
296 "ymax" / y2, &
297 "zmin" / z1, &
298 "zmax" / z2, &
299 "fargo/method" / 0, &
300 "gparam" / gpar)
301
302 ! boundary conditions
303 boundary => dict( &
304 "western" / bc(west), &
305 "eastern" / bc(east), &
306 "southern" / bc(south), &
307 "northern" / bc(north), &
308 "bottomer" / bc(bottom), &
309 "topper" / bc(top))
310
311
312 ! physics settings
313 physics => dict( &
314 "problem" / euler_isotherm, &
315 "units" / geometrical, &
316 "cs" / csiso)
317
318 ! flux calculation and reconstruction method
319 fluxes => dict( &
320 "order" / linear, &
321 "fluxtype" / kt, &
322 "variables" / primitive, &
323 "limiter" / vanleer, &
324 "theta" / 1.2)
325
326 ! source term due to viscosity
327 vis => dict( &
328 "stype" / viscosity, &
329 "vismodel" / vistype, &
330 "dynconst" / (1./re), &
331 "exponent" / pl_exp, &
332 "cvis" / cvis)
333
334 ! source term due to a point mass
335 grav => dict( &
336 "stype" / gravity, &
337 "pmass/gtype"/ pointmass, & ! grav. accel. of a point mass
338 "pmass/mass" / 1.0, & ! non-dim. mass of the accreting object
339 "pmass/x" / x0, & ! cartesian position of point mass
340 "pmass/y" / y0, &
341 "pmass/outbound" / 0) ! disable accretion
342
343 ! combine all source terms
344 sources => dict( &
345 "grav" / grav, &
346 "viscosity" / vis)
347
348 ! time discretization settings
349 timedisc => dict( &
350 "method" / ssprk, &
351 "stoptime" / (tsim * tvis), &
352 "cfl" / 0.4, &
353 "dtlimit" / (1e-10 * tvis), &
354! "rhstype" / 1, &
355 "maxiter" / 100000000, &
356 "tol_rel" / 0.01, &
357 "tol_abs" / (/1e-16,1e-2,1e-6/))
358
359 ! enable output of analytical solution
360#ifdef HAVE_FGSL
361 IF (mgeo.EQ.cylindrical) &
362 CALL setattr(timedisc,"output/solution",1)
363#endif
364
365 ! initialize data input/output
366 datafile => dict( &
367 "fileformat"/ vtk, &
368 "filename" / (trim(odir) // trim(ofname)), &
369 "count" / onum)
370
371 config => dict( &
372 "mesh" / mesh, &
373 "physics" / physics, &
374 "boundary" / boundary, &
375 "fluxes" / fluxes, &
376 "sources" / sources, &
377 "timedisc" / timedisc, &
378 "datafile" / datafile)
379 END SUBROUTINE makeconfig
380
381 SUBROUTINE initdata(Sim,Mesh,Physics,Timedisc,Sources)
384 IMPLICIT NONE
385 !------------------------------------------------------------------------!
386 CLASS(fosite), INTENT(INOUT) :: Sim
387 CLASS(physics_base), INTENT(IN) :: Physics
388 CLASS(mesh_base), INTENT(IN) :: Mesh
389 CLASS(timedisc_base), INTENT(INOUT) :: Timedisc
390 CLASS(sources_list),ALLOCATABLE,INTENT(IN) :: Sources
391 !------------------------------------------------------------------------!
392 ! Local variable declaration
393 CLASS(sources_base), POINTER :: sp
394 CLASS(sources_gravity), POINTER :: gp => null()
395 INTEGER :: i,j,k
396 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,3) &
397 :: posvec,ephi
398 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX) :: radius
399 REAL :: r,vr,vphi,sden,mu
400 CHARACTER(LEN=64) :: value
401 !------------------------------------------------------------------------!
402 ! get gravitational acceleration
403 NULLIFY(gp)
404 IF (ALLOCATED(sources)) THEN
405 sp => sources%GetSourcesPointer(gravity)
406 IF (ASSOCIATED(sp)) THEN
407 SELECT TYPE(sp)
408 CLASS IS(sources_gravity)
409 gp => sp
410 CLASS DEFAULT
411 ! do nothing
412 END SELECT
413 END IF
414 END IF
415 IF (.NOT.ASSOCIATED(gp)) &
416 CALL physics%Error("pringle::InitData","no gravity term initialized")
417
418 IF (abs(x0).LE.tiny(x0).AND.abs(y0).LE.tiny(y0)) THEN
419 ! no shift of point mass set radius and posvec to Mesh defaults
420 radius(:,:,:) = mesh%radius%bcenter(:,:,:)
421 posvec(:,:,:,:) = mesh%posvec%bcenter(:,:,:,:)
422 ELSE
423 ! shifted point mass position:
424 ! compute curvilinear components of shift vector
425 posvec(:,:,:,1) = x0
426 posvec(:,:,:,2) = y0
427 posvec(:,:,:,3) = z0
428 CALL mesh%Geometry%Convert2Curvilinear(mesh%bcenter,posvec,posvec)
429 ! subtract the result from the position vector:
430 ! this gives you the curvilinear components of all vectors pointing
431 ! from the point mass to the bary center of any cell on the mesh
432 posvec(:,:,:,:) = mesh%posvec%bcenter(:,:,:,:) - posvec(:,:,:,:)
433 ! compute its absolute value
434 radius(:,:,:) = sqrt(posvec(:,:,:,1)**2+posvec(:,:,:,2)**2+posvec(:,:,:,3)**2)
435 END IF
436
437 ! curvilinear components of azimuthal unit vector
438 ! (maybe with respect to shifted origin)
439 ! from ephi = ez x er = ez x posvec/radius = ez x (rxi*exi + reta*eeta)/r
440 ! = rxi/r*(ez x exi) + reta/r*(ez x eeta) = rxi/r*eeta - reta/r*exi
441 ! because (ez,exi,eeta) is right handed orthonormal set of basis vectors
442 ephi(:,:,:,1) = -posvec(:,:,:,2)/radius(:,:,:)
443 ephi(:,:,:,2) = posvec(:,:,:,1)/radius(:,:,:)
444 ephi(:,:,:,3) = 0.0
445
446 ! custom boundary conditions if requested
447 SELECT TYPE(bwest => timedisc%Boundary%boundary(west)%p)
448 CLASS IS (boundary_custom)
449 CALL bwest%SetCustomBoundaries(mesh,physics, &
450 (/custom_nograd,custom_outflow,custom_kepler/))
451 END SELECT
452 SELECT TYPE(beast => timedisc%Boundary%boundary(east)%p)
453 CLASS IS (boundary_custom)
454 CALL beast%SetCustomBoundaries(mesh,physics, &
455 (/custom_logexpol,custom_outflow,custom_kepler/))
456 END SELECT
457
458 SELECT CASE(vistype)
459 CASE(beta)
460 mu=1.0
461 CASE(powerlaw)
462 mu=pl_exp
463 CASE DEFAULT
464 CALL timedisc%Error("pringle::InitData","only pringle and beta viscosity possible")
465 END SELECT
466
467 ! initial condition
468 SELECT TYPE(pvar => timedisc%pvar)
469 TYPE IS(statevector_eulerisotherm)
470 DO k=mesh%KGMIN,mesh%KGMAX
471 DO j=mesh%JGMIN,mesh%JGMAX
472 DO i=mesh%IMIN,mesh%IGMAX
473 ! distance to center of mass
474 r = radius(i,j,k)
475 ! Keplerian velocity
476 vphi = sqrt(1.0/r)
477#ifdef HAVE_FGSL
478 ! use exact solution at time TINIT
479 CALL viscousring_analytic(mu,tinit,r,sden,vr)
480#else
481 ! use approximation for TINIT << 1
482 ! no need for modified Bessel functions
483 CALL viscousring_approx(mu,tinit,r,sden,vr)
484#endif
485 pvar%density%data3d(i,j,k) = rhomin + sden
486 ! curvilinear velocity components
487 pvar%velocity%data4d(i,j,k,1:2) = &
488 vr*posvec(i,j,k,1:2)/r + vphi*ephi(i,j,k,1:2)
489! pvar%velocity%data4d(i,j,k,1:2) = vr*posvec(i,j,k,1:2)/r
490! p%velocity%data4d(i,j,k,2) = vphi
491 END DO
492 END DO
493 END DO
494! CALL gp%UpdateGravity(Mesh,Sim%Physics,Sim%Fluxes,pvar,0.0,0.0)
495! pvar%velocity%data4d(:,:,:,1:Physics%VDIM) = &
496! Timedisc%GetCentrifugalVelocity(Mesh,Sim%Physics,Sim%Fluxes,Sim%Sources,(/0.,0.,1./), &
497! gp%accel%data4d)
498 CLASS DEFAULT
499 CALL timedisc%Error("pringle::InitData","only isothermal physics possible")
500 END SELECT
501
502 IF (ASSOCIATED(timedisc%solution)) THEN
503 ! store initial condition in exact solution array
504 timedisc%solution = timedisc%pvar
505 END IF
506
507 ! check fargo and set background velocity field
508 SELECT CASE(mesh%fargo%GetType())
509 CASE(1,2)
510 SELECT CASE(mesh%fargo%GetDirection())
511 CASE(1)
512 timedisc%w(:,:) = sqrt(1.0/radius(mesh%IMIN,:,:))
513 CASE(2)
514 timedisc%w(:,:) = sqrt(1.0/radius(:,mesh%IMIN,:))
515 CASE(3)
516 timedisc%w(:,:) = sqrt(1.0/radius(:,:,mesh%KMIN))
517 END SELECT
518 END SELECT
519
520 ! transform to conservative variables
521 CALL physics%Convert2Conservative(timedisc%pvar,timedisc%cvar)
522
523 CALL mesh%Info(" DATA-----> initial condition: " // "viscous spreading ring")
524 WRITE(value,"(ES11.3)") tvis
525 CALL mesh%Info(" " // "viscous timescale: " //trim(value))
526 WRITE(value,"(ES11.3)") re
527 CALL mesh%Info(" " // "Reynolds number: " //trim(value))
528 WRITE(value,"(ES11.3)") ma
529 CALL mesh%Info(" " // "Mach number: " //trim(value))
530
531 END SUBROUTINE initdata
532
533
534 SUBROUTINE viscousring_approx(mu,tau,r,Sigma,vr)
535 IMPLICIT NONE
536 !--------------------------------------------------------------------!
537 REAL, INTENT(IN) :: mu,tau,r
538 REAL, INTENT(OUT) :: Sigma,vr
539 !--------------------------------------------------------------------!
540 REAL :: lambda,x,r4l,invr4l
541 !--------------------------------------------------------------------!
542 lambda = 1./(4.0-mu)
543 r4l = r**(0.25/lambda)
544 x = 2*lambda**2 / tau * r**(0.25/lambda)
545 invr4l = 1./r4l
546 sigma = mdisk/sqrt((4*pi)**3 * tau) * r4l**(1.5-9*lambda) &
547 * exp(-lambda**2/tau*(1.0-r4l)**2)
548 vr = -1.5/re * ((x*tau)/(2*lambda*lambda))**(4*lambda-2.) &
549 * (1.0 - 0.5*x/lambda * (x*tau/(2*lambda*lambda) - 1.0))
550 END SUBROUTINE viscousring_approx
551
552#ifdef HAVE_FGSL
553 SUBROUTINE viscousring_analytic(mu,tau,r,Sigma,vr)
554 IMPLICIT NONE
555 !--------------------------------------------------------------------!
556 REAL, INTENT(IN) :: mu,tau,r
557 REAL, INTENT(OUT) :: Sigma,vr
558 !--------------------------------------------------------------------!
559 REAL :: lambda,r4l,x
560 !--------------------------------------------------------------------!
561 lambda = 1./(4.0-mu)
562 r4l = r**(0.25/lambda)
563 x = 2*lambda**2 / tau * r4l
564 sigma = mdisk/(4*pi) * (lambda/tau) * r4l**2 * r**(-2.25) &
565 * exp(-lambda**2/tau*(1.0+r4l**2)) &
566 * modified_bessel_inu(lambda,x)
567 vr = -1.5/re * ((x*tau)/(2*lambda*lambda))**(4*lambda-2.) &
568 * (1.0 - 0.5*x/lambda * (x*tau/(2*lambda*lambda) &
569 - modified_bessel_inu(1+lambda,x)/modified_bessel_inu(lambda,x)))
570 END SUBROUTINE viscousring_analytic
571
572 FUNCTION modified_bessel_inu(nu,x) RESULT(Inu)
573 USE fgsl
574 IMPLICIT NONE
575 !--------------------------------------------------------------------!
576 REAL, INTENT(IN) :: nu,x
577 REAL :: inu
578 !--------------------------------------------------------------------!
579 INTEGER :: n
580 !--------------------------------------------------------------------!
581 IF (aint(nu).EQ.nu) THEN
582 ! nu is an integer -> use modified bessel functions of integer order
583 n = int(nu)
584 inu = fgsl_sf_bessel_icn(n,x)
585 ELSE
586 ! nu is not an integer -> use representation of modified bessel functions
587 ! through hypergeometric functions 0F1
588 inu = (0.5*x)**nu / fgsl_sf_gamma(1.0+nu) * fgsl_sf_hyperg_0f1(1.0+nu,(0.5*x)**2)
589 END IF
590 END FUNCTION modified_bessel_inu
591#endif
592
593END PROGRAM pringle_test
subroutine initdata(Mesh, Physics, Fluxes, Timedisc)
Definition: bondi2d.f90:274
subroutine makeconfig(Sim, config)
Definition: bondi2d.f90:165
Dictionary for generic data types.
Definition: common_dict.f90:61
type(dict_typ) function, pointer, public dict(n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11, n12, n13, n14, n15, n16, n17, n18, n19, n20)
Construct a new dictionary from several key/value pairs. Together with the Assign subroutine and over...
Mathematical functions.
Definition: functions.f90:48
real, parameter pi
Definition: functions.f90:52
elemental real function, public asinh(x)
inverse hyperbolic sine function
Definition: functions.f90:100
generic source terms module providing functionaly common to all source terms
generic gravity terms module providing functionaly common to all gravity terms
subroutine viscousring_analytic(mu, tau, r, Sigma, vr)
Definition: pringle.f90:554
program pringle_test
Definition: pringle.f90:48
real function modified_bessel_inu(nu, x)
Definition: pringle.f90:573
subroutine viscousring_approx(mu, tau, r, Sigma, vr)
Definition: pringle.f90:535
main fosite class
Definition: fosite.f90:71