Scrambler  1
Bondi.f90
Go to the documentation of this file.
00001 !#########################################################################
00002 !               
00003 !    Copyright (C) 2003-2012 Department of Physics and Astronomy,
00004 !                            University of Rochester,
00005 !                            Rochester, NY
00006 !
00007 !    Bondi.f90 is part of AstroBEAR.
00008 !
00009 !    AstroBEAR is free software: you can redistribute it and/or modify    
00010 !    it under the terms of the GNU General Public License as published by 
00011 !    the Free Software Foundation, either version 3 of the License, or    
00012 !    (at your option) any later version.
00013 !
00014 !    AstroBEAR is distributed in the hope that it will be useful, 
00015 !    but WITHOUT ANY WARRANTY; without even the implied warranty of
00016 !    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00017 !    GNU General Public License for more details.
00018 !
00019 !    You should have received a copy of the GNU General Public License
00020 !    along with AstroBEAR.  If not, see <http://www.gnu.org/licenses/>.
00021 !
00022 !#########################################################################
00023 MODULE Bondi
00024   USE GlobalDeclarations
00025   USE PhysicsDeclarations
00026   USE DataDeclarations
00027   IMPLICIT NONE
00028   PUBLIC :: BH_alpha, fill_alpha_table, Bondi_lambda_critical, InitializeBondi
00029   SAVE
00030   REAL(KIND=qPREC), PUBLIC :: Bondi_lambda, Bondi_lambda2
00031 
00032   PRIVATE
00033   INTEGER, PARAMETER :: NrAlphaBins=513
00034   REAL(KIND=qPREC), POINTER, DIMENSION(:,:) :: Bondi_alpha_table, init_alpha_table
00035   REAL(KIND=qPREC) :: Bondi_gamma
00036 !  REAL(KIND=qPREC) :: GM, mass, xloc(3), vel(3), rho_inf, c_inf, radius, r_BH, Bondi_lambda, Bondi_lambda2,p0, c_inf2, half_angle=1.570796327d0, rho, v_r, temperature, r_circle, radial_refinements(0:MaxDepth)
00037 !  LOGICAL :: lFixed, lCircular_Boundary, lSet_Boundary
00038 !  INTEGER :: iBondi_Particle,iRoutine
00039 
00040 CONTAINS
00041 
00042 
00043   SUBROUTINE InitializeBondi()
00044     IF (nDim == 1) RETURN
00045     Bondi_lambda=Bondi_lambda_critical()
00046     Bondi_lambda2=Bondi_lambda**2
00047     CALL fill_alpha_table()
00048   END SUBROUTINE InitializeBondi
00049 
00050 
00051   FUNCTION Bondi_lambda_critical()
00052     REAL(KIND=qPREC) :: Bondi_lambda_critical
00053     SELECT CASE(mydim)
00054     CASE(1)
00055        Bondi_lambda_critical = 1d0
00056     CASE(2)
00057        IF (gamma <= 1.000001) THEN
00058           Bondi_lambda_critical=1.6487212707001281468486507878142d0 ! exp(.5) = sqrt(e)
00059           Bondi_gamma=1.000001
00060        ELSE IF (gamma >= 2.99999) THEN
00061           Bondi_lambda_critical = 1d0
00062           Bondi_gamma = 2.99999
00063        ELSE
00064           Bondi_gamma=gamma
00065           Bondi_lambda_critical =sqrt(((3d0-Bondi_gamma)/2d0*(2d0/(3d0-Bondi_gamma))**(2d0/(Bondi_gamma-1d0))))
00066        END IF
00067     CASE(3)
00068        IF (gamma <= 1.000000000001) THEN
00069           Bondi_lambda_critical=1.12042226758452d0
00070           Bondi_gamma = 1.000000000001
00071        ELSE IF (gamma >= 1.666666666667) THEN
00072           Bondi_lambda_critical = .25000000000000000d0
00073           Bondi_gamma = 1.666666666667
00074        ELSE
00075           Bondi_gamma=gamma
00076 
00077            ! Original version does not group large cancelling terms... leads to infinity times 0
00078 !          Bondi_lambda_critical = (.5d0)**((gamma+1d0)/(2d0*gamma1)) * (1.25d0-.75d0*gamma)**(-(5d0-3d0*gamma)/(2d0*gamma1))
00079 
00080           
00081            ! Grouping cancelling terms makes calculation more accurate
00082 !          Calculation in log space seems to give same answer
00083 !          Bondi_lambda_critical = exp(log(((.5d0)/(1.25d0-.75d0*Bondi_gamma)))*((Bondi_gamma+1d0)/(2d0*(Bondi_gamma-1d0))) + log(((1.25d0-.75d0*Bondi_gamma)))*(-(5d0-3d0*Bondi_gamma)/(2d0*(Bondi_gamma-1d0))+(Bondi_gamma+1d0)/(2d0*(Bondi_gamma-1d0))))
00084 
00085         
00086           Bondi_lambda_critical = ((.5d0)/(1.25d0-.75d0*Bondi_gamma))**((Bondi_gamma+1d0)/(2d0*(Bondi_gamma-1d0))) * ((1.25d0-.75d0*Bondi_gamma))**(-(5d0-3d0*Bondi_gamma)/(2d0*(Bondi_gamma-1d0))+(Bondi_gamma+1d0)/(2d0*(Bondi_gamma-1d0)))
00087        END IF
00088     END SELECT
00089   END FUNCTION Bondi_lambda_critical
00090 
00091 
00092   SUBROUTINE fill_alpha_table()
00093     complex(8) :: a,b,e,f, h, P, Q, R, U, W, x, y, z
00094     INTEGER :: i,j
00095     REAL(8) :: temp_new, temp_prev, c,d,g
00096     LOGICAL :: lDiverging
00097     CHARACTER(LEN=40) :: Filename
00098     LOGICAL :: lswitch=.true.
00099     ALLOCATE(Bondi_alpha_table(NrAlphaBins,2))
00100     i=0
00101     j=NrAlphaBins
00102     temp_new = 1000d0
00103     lDiverging=.false.
00104 !    lswitch=.false.
00105     SELECT CASE (mydim)
00106     CASE(2)
00107        b=-1d0
00108        e=b**2
00109        DO WHILE (j >=1)
00110           i=i+1
00111           z=1.02d0**i
00112           a=(z**(Bondi_gamma-1d0)-1d0)/(Bondi_gamma-1d0)
00113           d=-b/(2d0*a)
00114           c=.5d0*Bondi_lambda2/z**2
00115           f=-4d0*a*c
00116           g=sqrt(abs(e+f))
00117           temp_prev=temp_new
00118           temp_new=min(g, 1000d0)
00119           IF (.NOT. lDiverging .AND. temp_new > temp_prev)  lDiverging=.true.
00120           IF (lDiverging .and. lswitch) THEN
00121              Bondi_alpha_table(j,1)=abs(d - g/(2d0*a))
00122           ELSE !diverging so switch solutions
00123              Bondi_alpha_table(j,1)=abs(d + g/(2d0*a))
00124           END IF
00125           Bondi_alpha_table(j,2)=z
00126           j=j-1
00127        END DO
00128     CASE(3)
00129        DO WHILE (j >=1)
00130           i=i+1
00131           z=1.02d0**i
00132           a=(z**(Bondi_gamma-1d0)-1d0)/(Bondi_gamma-1d0)
00133           b=-1d0
00134           e=.5d0*Bondi_lambda2/z**2
00135           f=-3d0/8d0*b**2/a**2
00136           g=b**3/(8d0*a**3)
00137           h=-3d0*b**4/(256d0*a**4)+e/a
00138           P=-f**2/12d0-h
00139           Q=-f**3/108d0+f*h/3d0-g**2/8d0
00140           R=-Q/2d0+(Q**2/4d0+P**3/27d0)**(.5d0)
00141           U=R**(1d0/3d0)
00142           IF (U==0) THEN
00143              y=-5d0/6d0*f-Q**(1d0/3d0)
00144           ELSE
00145              y=-5d0/6d0*f+U-P/(3d0*U)
00146           END IF
00147           W=sqrt(abs(f+2d0*y))
00148           IF (REAL(3d0*f+2d0*y+2d0*g/W) > 0d0) CYCLE
00149           temp_prev=temp_new
00150           temp_new=min(sqrt(abs(-(3d0*f+2d0*y+2d0*g/W))), 1000d0)
00151           IF (.NOT. lDiverging .AND. temp_new > temp_prev)  lDiverging=.true.
00152           IF (lDiverging .and. lswitch) THEN
00153              Bondi_alpha_table(j,1)=abs(-b/(4d0*a)+(W-sqrt(abs(-(3d0*f+2d0*y+2d0*g/W))))/2d0)
00154           ELSE !diverging so switch solutions
00155              Bondi_alpha_table(j,1)=abs(-b/(4d0*a)+(W+sqrt(abs(-(3d0*f+2d0*y+2d0*g/W))))/2d0)
00156           END IF
00157           Bondi_alpha_table(j,2)=z
00158           j=j-1
00159        END DO
00160     END SELECT
00161     
00162     IF (MPI_ID == 0) THEN
00163        WRITE(FileName, '(1A)') "Bondi_alpha.tab"
00164        OPEN(UNIT=BONDI_DATA_HANDLE, file=FileName, status="unknown")
00165        write(BONDI_DATA_HANDLE, '(2E16.5)') transpose(Bondi_alpha_table)
00166        close(BONDI_DATA_HANDLE)
00167     END IF
00168   END SUBROUTINE fill_alpha_table
00169 
00170   function BH_alpha(x)
00171     REAL(KIND=qPREC) :: BH_alpha, x
00172     INTEGER :: slot
00173     INTEGER :: i
00174 
00175     IF (x <= Bondi_alpha_table(1,1)) THEN
00176        BH_alpha=Bondi_alpha_table(1,2)+(x-Bondi_alpha_table(1,1))*(Bondi_alpha_table(2,2)-Bondi_alpha_table(1,2))/(Bondi_alpha_table(2,1)-Bondi_alpha_table(1,1))
00177     ELSE IF (x >= Bondi_alpha_table(NrAlphaBins,1)) THEN
00178        BH_alpha = 1d0
00179     ELSE
00180        slot=256
00181        DO i=1,8
00182           IF (x>Bondi_alpha_table(slot+1,1)) THEN
00183              slot=slot+2**(8-i)
00184           ELSE
00185              slot=slot-2**(8-i)
00186           END IF
00187        END DO
00188        IF (x>Bondi_alpha_table(slot+1,1)) THEN
00189           slot=slot+1
00190        END IF
00191        BH_alpha=Bondi_alpha_table(slot,2)+(x-Bondi_alpha_table(slot,1))*(Bondi_alpha_table(slot+1,2)-Bondi_alpha_table(slot,2))/(Bondi_alpha_table(slot+1,1)-Bondi_alpha_table(slot,1))
00192     END IF
00193   END function BH_alpha
00194 
00195 
00196 
00197 
00198 END MODULE Bondi
00199 
00200 
00201 
 All Classes Files Functions Variables