Scrambler
1
|
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