# Blog: Meeting Update June-17th Erini: problem.f90

File problem.f90, 5.5 KB (added by , 11 years ago) |
---|

Line | |
---|---|

1 | !######################################################################### |

2 | ! |

3 | ! Copyright (C) 2003-2012 Department of Physics and Astronomy, |

4 | ! University of Rochester, |

5 | ! Rochester, NY |

6 | ! |

7 | ! problem.f90 of module BonnorEbertSphere is part of AstroBEAR. |

8 | ! |

9 | ! AstroBEAR is free software: you can redistribute it and/or modify |

10 | ! it under the terms of the GNU General Public License as published by |

11 | ! the Free Software Foundation, either version 3 of the License, or |

12 | ! (at your option) any later version. |

13 | ! |

14 | ! AstroBEAR is distributed in the hope that it will be useful, |

15 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of |

16 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |

17 | ! GNU General Public License for more details. |

18 | ! |

19 | ! You should have received a copy of the GNU General Public License |

20 | ! along with AstroBEAR. If not, see <http://www.gnu.org/licenses/>. |

21 | ! |

22 | !######################################################################### |

23 | !============================================================================ |

24 | ! This problem places a bonner ebert sphere in the center of the grid. |

25 | !============================================================================ |

26 | |

27 | |

28 | MODULE PROBLEM |

29 | USE DataDeclarations |

30 | USE GlobalDeclarations |

31 | USE PhysicsDeclarations |

32 | USE LE_MODULE |

33 | USE Profiles |

34 | USE WINDS |

35 | USE CLUMPS |

36 | USE Ambients |

37 | USE Totals |

38 | |

39 | IMPLICIT NONE ! It's safer to require explicit declarations |

40 | SAVE ! Save module information |

41 | PRIVATE |

42 | |

43 | PUBLIC ProblemModuleInit, ProblemGridInit, & |

44 | ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep |

45 | |

46 | TYPE(WindDef), POINTER :: Wind |

47 | TYPE(ClumpDef), POINTER :: MyClump |

48 | TYPE(AmbientDef), POINTER :: Ambient |

49 | TYPE(TotalDef), POINTER :: Total |

50 | TYPE(InfoDef), POINTER :: Info |

51 | TYPE(ProfileDef), Pointer :: Profile |

52 | INTEGER :: nWinds |

53 | REAL(KIND=qPrec), DIMENSION(3) :: xloc=(/0,0,0/) |

54 | REAL(KIND=qPrec) :: R_outer,h,dtheta,a_scale,p_cent,temp_cent |

55 | REAL :: xi_last,xi, at,poly_index,M_star,rho_cent |

56 | REAL(KIND=qPrec) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut, crit_rad, p_crit |

57 | REAL(KIND=qPrec) :: Omega, tff |

58 | INTEGER :: npoints |

59 | NAMELIST /ProblemData/ poly_index,rho_cent,M_star |

60 | NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut |

61 | |

62 | |

63 | CONTAINS |

64 | |

65 | SUBROUTINE ProblemModuleInit() |

66 | |

67 | INTEGER :: i, edge |

68 | |

69 | |

70 | OPEN(UNIT = PROBLEM_DATA_HANDLE, FILE = 'problem.data') |

71 | READ(PROBLEM_DATA_HANDLE, NML=ProblemData) |

72 | READ(PROBLEM_DATA_HANDLE, NML=AmbientData) |

73 | CLOSE(PROBLEM_DATA_HANDLE) |

74 | rho_cent = rho_cent*hmass*Xmu ! now is g/cc |

75 | |

76 | CALL CreateAmbient(Ambient) |

77 | Ambient%density=1d0 |

78 | Ambient%pressure=1d0 |

79 | Ambient%B(:)=(/BxOut,ByOut,BzOut/) |

80 | Ambient%velocity(:)=(/vxOut, vyOut, vzOut/) |

81 | |

82 | CALL CreateProfile(Profile, nPoints, (/Mass_Field, P_Field/), RADIAL) |

83 | CALL ConstructPolytropeProfile(Profile,R_outer, poly_index, rho_cent, M_star, xi_last,a_scale,p_cent,temp_cent) |

84 | DO i=1,nPoints |

85 | Profile%data(i,:)=Profile%data(i,:) / (/lScale, rScale, pScale, TempScale/) !rescale to cu |

86 | END DO |

87 | |

88 | CLOSE(PROBLEM_DATA_HANDLE) |

89 | |

90 | |

91 | END SUBROUTINE ProblemModuleInit |

92 | |

93 | SUBROUTINE ProblemGridInit(Info) !Specific for each info structure |

94 | Type(InfoDef) :: Info |

95 | INTEGER :: i, j, k, mx, my, mz |

96 | INTEGER :: mbc, rmbc, zrmbc |

97 | INTEGER :: nx, ny, nz |

98 | INTEGER :: ndim |

99 | REAL(KIND=xPrec):: x, y, z, xlower, ylower, zlower,dx, dy, dz, r,rho_profile |

100 | RETURN |

101 | |

102 | ! OPEN(UNIT = PROBLEM_DATA_HANDLE, FILE = 'problem.data') |

103 | ! READ(PROBLEM_DATA_HANDLE, NML=ProblemData) |

104 | ! CALL ConstructPolytropeProfile(Profile,R_outer, poly_index, rho_cent, M_star, xi_last,a_scale,p_cent,temp_cent) |

105 | !Profile%data(:,2)=rho_profile(r) |

106 | |

107 | !rmbc=levels(Info%level)%gmbc(levels(Info%level)%step) |

108 | ! mx=Info%mx(1); xlower=Info%Xbounds(1,1) |

109 | ! my=Info%mx(2); ylower=Info%Xbounds(2,1) |

110 | ! mz=Info%mx(3); zlower=Info%Xbounds(3,1) |

111 | !dx=levels(Info%level)%dx |

112 | !SELECT CASE(nDim) |

113 | ! CASE(2) |

114 | ! zrmbc=0 |

115 | ! mz=1 |

116 | ! zlower=0 |

117 | ! dz=0 |

118 | ! CASE(3) |

119 | ! zrmbc=rmbc |

120 | ! END SELECT |

121 | !Do k=1-zrmbc, mz+zrmbc |

122 | ! Do j=1-rmbc, my+rmbc |

123 | ! Do i=1-rmbc, mx+rmbc |

124 | ! x=(xlower + (REAL(i, xPrec)-half)*dx) |

125 | ! y=(ylower + (REAL(j, xPrec)-half)*dx) |

126 | ! z=(zlower + (REAL(k, xPrec)-half)*dx) |

127 | ! r = Sqrt(x**2+y**2+z**2) |

128 | ! r = (r*lscale)*a_scale ! takes r to cgs to xi |

129 | ! at = (2*R_outer*SQRT(PI*G*rho_cent))/xi_last |

130 | ! Info%q(i,j,k,1)=rho_profile(r) |

131 | ! Info%q(i,j,k,iE) =(((Info%q(i,j,k,1)*rScale*(aT**2))/gamma)*gamma7)/pScale |

132 | |

133 | |

134 | !Info%q(i,j,k,iE) = (((Info%q(i,j,k,1)*rscale*(aT**2))/gamma)*gamma7)/pScaleA |

135 | ! END DO |

136 | ! END DO |

137 | ! END DO |

138 | !CLOSE(PROBLEM_DATA_HANDLE) |

139 | |

140 | END SUBROUTINE ProblemGridInit |

141 | SUBROUTINE ProblemBeforeStep(INFO) |

142 | |

143 | TYPE(INFODEF) :: INFO |

144 | INTEGER :: i |

145 | |

146 | END SUBROUTINE ProblemBeforeStep |

147 | |

148 | SUBROUTINE ProblemAfterStep(INFO) |

149 | TYPE(INFODEF) :: INFO |

150 | ! No special after step instructions needed; this is a stub. |

151 | |

152 | END SUBROUTINE ProblemAfterStep |

153 | SUBROUTINE ProblemSetErrFlag(INFO) |

154 | TYPE(INFODEF) :: INFO |

155 | ! No special instructions needed; this is a stub. |

156 | |

157 | END SUBROUTINE ProblemSetErrFlag |

158 | |

159 | SUBROUTINE ProblemBeforeGlobalStep(n) |

160 | INTEGER :: n |

161 | END SUBROUTINE ProblemBeforeGlobalStep |

162 | |

163 | |

164 | END MODULE PROBLEM |