Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! pointgravity.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 PointGravitySrc 00024 USE HyperbolicDeclarations 00025 USE DataDeclarations 00026 USE PhysicsDeclarations 00027 USE EOS 00028 USE SourceDeclarations 00029 USE CommonFunctions 00030 IMPLICIT NONE 00031 PRIVATE 00032 PUBLIC :: PointGravity, PointGravity_inst, CreatePointGravityObject, DestroyPointGravityObject, CheckParticlePositions, PointGravityInit, PointGravityPotential 00033 PUBLIC :: PointGravity_CountObjects, FindPointGravityObject 00034 PUBLIC :: PointGravity_InitChomboDatasets, PointGravity_WriteObjectToChombo, PointGravity_ReadObjectFromChombo 00035 00036 TYPE, PUBLIC :: PointGravityDef 00037 REAL(KIND=qPREC), DIMENSION(3) :: x0 = 0 00038 REAL(KIND=qPREC) :: t0 = 0 00039 REAL(KIND=qPREC), DIMENSION(3) :: v0 = 0 00040 REAL(KIND=qPREC) :: alpha = 1d0 00041 REAL(KIND=qPREC) :: mass = 0 00042 REAL(KIND=qPrec) :: dmom(0:MaxDepth,3) = 0 00043 REAL(KIND=qPREC) :: soft_length = 0 00044 INTEGER :: soft_function = NOSOFT 00045 INTEGER :: id 00046 00047 TYPE(PointGravityDef), POINTER :: previous, next 00048 END TYPE PointGravityDef 00049 00050 TYPE(PointGravityDef),PUBLIC,POINTER :: FirstPointGravityObj, LastPointGravityObj 00051 INTEGER :: nPointGravityObjects 00052 00054 TYPE, PUBLIC :: pPointGravityDef 00055 TYPE(PointGravityDef), POINTER :: p 00056 END TYPE pPointGravityDef 00057 00058 CONTAINS 00059 00060 SUBROUTINE PointGravityInit() 00061 NULLIFY(FirstPointGravityObj, LastPointGravityObj) 00062 nPointGravityObjects=0 00063 END SUBROUTINE PointGravityInit 00064 00065 SUBROUTINE CheckParticlePositions() 00066 TYPE(PointGravityDef), POINTER :: PointGravityObj 00067 IF (ANY(lHydroPeriodic)) THEN 00068 PointGravityObj=>FirstPointGravityObj 00069 DO WHILE (ASSOCIATED(PointGravityObj)) 00070 WHERE (lHydroPeriodic) PointGravityObj%x0=PointGravityObj%x0-floor((PointGravityObj%x0+PointGravityObj%v0*(levels(MaxLevel)%tnow-PointGravityObj%t0) - GxBounds(:,1))/(GxBounds(:,2)-GxBounds(:,1)))*(GxBounds(:,2)-GxBounds(:,1)) 00071 PointGravityObj=>PointGravityObj%next 00072 END DO 00073 END IF 00074 END SUBROUTINE CheckParticlePositions 00075 00076 00077 SUBROUTINE PointGravity(q,dt,x,t,dv, level,lform) 00078 USE CommonFunctions 00079 ! Interface declarations 00080 00081 REAL(KIND=qPrec) :: q(:) 00082 REAL(KIND=qPrec) :: dt,x(3),dx,pos(3),t, pOffset(3),r2,r,f_grav(3), dv 00083 00084 ! Internal declarations 00085 TYPE(PointGravityDef),POINTER :: PointGravityObj 00086 LOGICAL :: lCool,lform 00087 INTEGER :: ioffset(3,2),i,j,k, level 00088 00089 ioffset=0 00090 WHERE(lHydroPeriodic(1:nDim)) ioffset(1:nDim,2)=2 !Checks the next periodic versions to the left and right 00091 ioffset(1:nDim,1)=-ioffset(1:nDim,2) 00092 00093 PointGravityObj=>FirstPointGravityObj 00094 DO WHILE(ASSOCIATED(PointGravityObj)) 00095 DO i=ioffset(1,1),ioffset(1,2) 00096 DO j=ioffset(2,1),ioffset(2,2) 00097 DO k=ioffset(3,1),ioffset(3,2) 00098 pOffSet=(/i,j,k/)*(GxBounds(:,2)-GxBounds(:,1)) 00099 pos=x - (PointGravityObj%x0+pOffset+(t+.5d0*dt-PointGravityObj%t0)*PointGravityObj%v0) 00100 f_grav=GravityForce(PointGravityObj%Mass, pos, PointGravityObj%soft_length, PointGravityObj%soft_function) 00101 IF (lform .eqv. PRIMITIVE) THEN 00102 q(imom(1:nDim))=q(imom(1:nDim))+f_grav(1:nDim)*dt 00103 ELSE 00104 q(imom(1:nDim))=q(imom(1:nDim))+f_grav(1:nDim)*q(1)*dt 00105 IF (iE .ne. 0) q(iE)=q(iE)+SUM(f_grav(1:nDim)*q(imom(1:nDim)))*dt 00106 END IF 00107 PointGravityObj%dMom(Level,1:nDim)=PointGravityObj%dMom(Level,1:nDim)-f_grav(1:nDim)*q(1)*dt*dv 00108 END DO 00109 END DO 00110 END DO 00111 PointGravityObj=>PointGravityObj%next 00112 00113 END DO 00114 END SUBROUTINE PointGravity 00115 00116 00117 SUBROUTINE PointGravity_inst(q,dqdt,x,t,lform) 00118 USE CommonFunctions 00119 ! Interface declarations 00120 REAL(KIND=qPrec) :: q(:) 00121 REAL(KIND=qPrec) :: dqdt(:),x(3),dx,pos(3),t, pOffset(3),r2,r,f_grav(3) 00122 ! Internal declarations 00123 TYPE(PointGravityDef),POINTER :: PointGravityObj 00124 LOGICAL :: lCool,lform 00125 INTEGER :: ioffset(3,2),i,j,k 00126 00127 ioffset=0 00128 WHERE(lHydroPeriodic(1:nDim)) ioffset(1:nDim,2)=2 !Checks the next periodic versions to the left and right 00129 ioffset(1:nDim,1)=-ioffset(1:nDim,2) 00130 00131 PointGravityObj=>FirstPointGravityObj 00132 DO WHILE(ASSOCIATED(PointGravityObj)) 00133 DO i=ioffset(1,1),ioffset(1,2) 00134 DO j=ioffset(2,1),ioffset(2,2) 00135 DO k=ioffset(3,1),ioffset(3,2) 00136 pOffSet=(/i,j,k/)*(GxBounds(:,2)-GxBounds(:,1)) 00137 pos=x - (PointGravityObj%x0+pOffset+(t-PointGravityObj%t0)*PointGravityObj%v0) 00138 f_grav=GravityForce(PointGravityObj%Mass, pos, PointGravityObj%soft_length, PointGravityObj%soft_function) 00139 IF (lform .eqv. PRIMITIVE) THEN 00140 dqdt(imom(1:nDim))=dqdt(imom(1:nDim))+f_grav(1:nDim) 00141 ELSE 00142 dqdt(imom(1:nDim))=dqdt(imom(1:nDim))+f_grav(1:nDim)*q(1) 00143 IF (iE .ne. 0) dqdt(iE)=dqdt(iE)+SUM(f_grav(1:nDim)*q(imom(1:nDim))) 00144 END IF 00145 END DO 00146 END DO 00147 END DO 00148 ! write(*,*) PointGravityObj%Mass, PointGravityObj%x0, x-pos 00149 PointGravityObj=>PointGravityObj%next 00150 00151 END DO 00152 ! STOP 00153 END SUBROUTINE PointGravity_inst 00154 00155 00156 00157 FUNCTION PointGravityPotential(PointGravityObj, pos, t) 00158 TYPE(PointGravityDef) :: PointGravityObj 00159 REAL(KIND=qPREC) :: PointGravityPotential 00160 REAL(KIND=qPREC) :: t, rpos(3),pos(3) 00161 rpos=pos-(PointGravityObj%x0+PointGravityObj%v0*(t-PointGravityObj%t0)) 00162 PointGravityPotential = GravityPotential(PointGravityObj%Mass, rpos, PointGravityObj%soft_length, PointGravityObj%soft_function) 00163 00164 END FUNCTION PointGravityPotential 00165 00166 ! ========================================== 00167 ! = PointGravity creation/destruction = 00168 ! = and list manipulation functions = 00169 ! ========================================== 00170 00171 SUBROUTINE CreatePointGravityObject(PointGravityObj) 00172 ! Interface declarations 00173 !INTEGER :: dummy 00174 TYPE(PointGravityDef),POINTER :: PointGravityObj 00175 00176 IF(ASSOCIATED(PointGravityObj)) THEN 00177 PRINT*,'PointGravity_source.f90::CreatePointGravityObject error -- Object already associated. Halting.' 00178 STOP 00179 END IF 00180 ALLOCATE(PointGravityObj) 00181 NULLIFY(PointGravityObj%previous) 00182 NULLIFY(PointGravityObj%next) 00183 nPointGravityObjects=nPointGravityObjects+1 00184 PointGravityObj%id=nPointGravityObjects 00185 CALL AddPointGravityObjToList(PointGravityObj) 00186 END SUBROUTINE CreatePointGravityObject 00187 00188 SUBROUTINE DestroyPointGravityObject(PointGravityObj,id) 00189 TYPE(PointGravityDef),POINTER :: PointGravityObj 00190 INTEGER,OPTIONAL :: id 00191 00192 IF(PRESENT(id)) THEN 00193 PointGravityObj=>FirstPointGravityObj 00194 DO WHILE(ASSOCIATED(PointGravityObj)) 00195 IF(PointGravityObj%id==id) THEN 00196 EXIT 00197 ELSE 00198 PointGravityObj=>PointGravityObj%next 00199 END IF 00200 END DO 00201 END IF 00202 CALL RemovePointGravityObjFromList(PointGravityObj) 00203 DEALLOCATE(PointGravityObj) 00204 NULLIFY(PointGravityObj) 00205 END SUBROUTINE DestroyPointGravityObject 00206 00207 SUBROUTINE AddPointGravityObjToList(PointGravityObj) 00208 TYPE(PointGravityDef),POINTER :: PointGravityObj 00209 00210 IF(.NOT. ASSOCIATED(FirstPointGravityObj)) THEN ! First PointGravity Object only 00211 FirstPointGravityObj=>PointGravityObj 00212 LastPointGravityObj=>PointGravityObj 00213 ELSE 00214 PointGravityObj%previous=>LastPointGravityObj 00215 LastPointGravityObj%next=>PointGravityObj 00216 LastPointGravityObj=>PointGravityObj 00217 END IF 00218 END SUBROUTINE AddPointGravityObjToList 00219 00220 SUBROUTINE RemovePointGravityObjFromList(PointGravityObj) 00221 TYPE(PointGravityDef),POINTER :: PointGravityObj 00222 00223 IF(ASSOCIATED(PointGravityObj%previous)) THEN 00224 PointGravityObj%previous%next=>PointGravityObj%next 00225 ELSE 00226 FirstPointGravityObj=>PointGravityObj%next 00227 END IF 00228 00229 IF(ASSOCIATED(PointGravityObj%next)) THEN 00230 PointGravityObj%next%previous=>PointGravityObj%previous 00231 ELSE 00232 LastPointGravityObj=>PointGravityObj%previous 00233 ! NULLIFY(LastPointGravityObj%next) 00234 END IF 00235 00236 END SUBROUTINE RemovePointGravityObjFromList 00237 00238 00240 INTEGER FUNCTION PointGravity_CountObjects() 00241 00242 TYPE(PointGravityDef), POINTER :: gravity_object 00243 00244 INTEGER :: counter 00245 00246 gravity_object => FirstPointGravityObj 00247 00248 counter = 0 00249 00250 DO WHILE(ASSOCIATED(gravity_object)) 00251 counter = counter + 1 00252 gravity_object => gravity_object%next 00253 END DO 00254 00255 PointGravity_CountObjects = counter 00256 00257 END FUNCTION PointGravity_CountObjects 00258 00261 SUBROUTINE FindPointGravityObject(id, gravity_object) 00262 00263 INTEGER :: id 00264 TYPE(PointGravityDef), POINTER :: gravity_object 00265 00266 TYPE(PointGravityDef), POINTER :: iter 00267 00268 00269 ! gravity_object will be returned as null if id is not found in the gravity object list. 00270 NULLIFY(gravity_object) 00271 00272 iter => FirstPointGravityObj 00273 ! Loop over the gravity object list. If an object with an ID matching id is found, then 00274 ! associate the input pointer and cease iterating. 00275 DO WHILE (ASSOCIATED(iter)) 00276 IF (iter%id == id) THEN 00277 gravity_object => iter 00278 EXIT 00279 END IF 00280 00281 iter => iter%next 00282 00283 END DO 00284 END SUBROUTINE FindPointGravityObject 00285 00289 SUBROUTINE PointGravity_InitChomboDatasets(chandle, obj_count) 00290 00291 USE ChomboDeclarations, ONLY: ChomboHandle 00292 USE HDF5Declarations, ONLY: Initialize_HDF5_Dataset_Int, Initialize_HDF5_Dataset_Double 00293 00294 TYPE(ChomboHandle), POINTER :: chandle 00295 00296 INTEGER :: i_err 00297 INTEGER :: obj_count 00298 INTEGER :: iFixed 00299 00300 00301 IF (.NOT. ASSOCIATED(chandle)) THEN 00302 PRINT *, "PointGravity_InitChomboDatasets error::invalid Chombo handle." 00303 STOP 00304 END IF 00305 00306 IF (obj_count < 0) THEN 00307 PRINT *, "PointGravity_InitChomboDatasets error::invalid object count ", obj_count, "." 00308 STOP 00309 END IF 00310 00311 ! The size of the datasets is up to the user; they do not all need to be of length obj_count. 00312 CALL Initialize_HDF5_Dataset_Int("id", chandle%source_group_id, obj_count) 00313 00314 ! Position coordinates 00315 CALL Initialize_HDF5_Dataset_Double("pos_x0", chandle%source_group_id, obj_count) 00316 CALL Initialize_HDF5_Dataset_Double("pos_y0", chandle%source_group_id, obj_count) 00317 CALL Initialize_HDF5_Dataset_Double("pos_z0", chandle%source_group_id, obj_count) 00318 00319 ! Velocity coordinates 00320 CALL Initialize_HDF5_Dataset_Double("vel_x0", chandle%source_group_id, obj_count) 00321 CALL Initialize_HDF5_Dataset_Double("vel_y0", chandle%source_group_id, obj_count) 00322 CALL Initialize_HDF5_Dataset_Double("vel_z0", chandle%source_group_id, obj_count) 00323 00324 CALL Initialize_HDF5_Dataset_Double("t0", chandle%source_group_id, obj_count) 00325 CALL Initialize_HDF5_Dataset_Double("mass", chandle%source_group_id, obj_count) 00326 CALL Initialize_HDF5_Dataset_Double("soft_length", chandle%source_group_id, obj_count) 00327 00328 CALL Initialize_HDF5_Dataset_Int("soft_function", chandle%source_group_id, obj_count) 00329 00330 END SUBROUTINE PointGravity_InitChomboDatasets 00331 00335 SUBROUTINE PointGravity_WriteObjectToChombo(chandle, gravity_object) 00336 00337 USE ChomboDeclarations, ONLY: ChomboHandle 00338 USE HDF5Declarations, ONLY: Write_Slab_To_Dataset_Int, Write_Slab_To_Dataset_Double 00339 00340 TYPE(ChomboHandle), POINTER :: chandle 00341 TYPE(PointGravityDef), POINTER :: gravity_object 00342 00343 00344 ! Write point gravity position variables. 00345 CALL Write_Slab_To_Dataset_Double("pos_x0", & 00346 chandle%source_group_id, & 00347 gravity_object%x0(1:1), & 00348 chandle%source_offset) 00349 00350 CALL Write_Slab_To_Dataset_Double("pos_y0", & 00351 chandle%source_group_id, & 00352 gravity_object%x0(2:2), & 00353 chandle%source_offset) 00354 00355 CALL Write_Slab_To_Dataset_Double("pos_z0", & 00356 chandle%source_group_id, & 00357 gravity_object%x0(3:3), & 00358 chandle%source_offset) 00359 00360 ! Write point gravity velocity variables. 00361 CALL Write_Slab_To_Dataset_Double("vel_x0", & 00362 chandle%source_group_id, & 00363 gravity_object%v0(1:1), & 00364 chandle%source_offset) 00365 00366 CALL Write_Slab_To_Dataset_Double("vel_y0", & 00367 chandle%source_group_id, & 00368 gravity_object%v0(2:2), & 00369 chandle%source_offset) 00370 00371 CALL Write_Slab_To_Dataset_Double("vel_z0", & 00372 chandle%source_group_id, & 00373 gravity_object%v0(3:3), & 00374 chandle%source_offset) 00375 00376 ! Point gravity time variable. 00377 CALL Write_Slab_To_Dataset_Double("t0", & 00378 chandle%source_group_id, & 00379 (/ gravity_object%t0 /), & 00380 chandle%source_offset) 00381 00382 CALL Write_Slab_To_Dataset_Double("mass", & 00383 chandle%source_group_id, & 00384 (/ gravity_object%mass /), & 00385 chandle%source_offset) 00386 00387 CALL Write_Slab_To_Dataset_Double("soft_length", & 00388 chandle%source_group_id, & 00389 (/ gravity_object%soft_length /), & 00390 chandle%source_offset) 00391 00392 CALL Write_Slab_To_Dataset_Int("soft_function", & 00393 chandle%source_group_id, & 00394 (/ gravity_object%soft_function /), & 00395 chandle%source_offset) 00396 00397 CALL Write_Slab_To_Dataset_Int("id", & 00398 chandle%source_group_id, & 00399 (/ gravity_object%id /), & 00400 chandle%source_offset) 00401 00402 chandle%source_offset = chandle%source_offset + 1 00403 00404 END SUBROUTINE PointGravity_WriteObjectToChombo 00405 00409 SUBROUTINE PointGravity_ReadObjectFromChombo(chandle, gravity_object) 00410 00411 USE ChomboDeclarations, ONLY: ChomboHandle 00412 USE HDF5Declarations, ONLY: Read_Slab_From_Dataset_Int, Read_Slab_From_Dataset_Double 00413 00414 TYPE(ChomboHandle), POINTER :: chandle 00415 TYPE(PointGravityDef), POINTER :: gravity_object 00416 00417 INTEGER, DIMENSION(1), TARGET :: int_buffer_array 00418 REAL(KIND=qPrec), DIMENSION(1), TARGET :: dbl_buffer_array 00419 INTEGER, DIMENSION(:), POINTER :: int_buffer 00420 REAL(KIND=qPrec), DIMENSION(:), POINTER :: dbl_buffer 00421 00422 00423 int_buffer => int_buffer_array 00424 dbl_buffer => dbl_buffer_array 00425 00426 int_buffer = 0 00427 dbl_buffer = 0.d0 00428 00429 ! Read point gravity position variables. 00430 CALL Read_Slab_From_Dataset_Double("pos_x0", & 00431 chandle%source_group_id, & 00432 dbl_buffer, & 00433 chandle%source_offset) 00434 00435 gravity_object%x0(1) = dbl_buffer(1) 00436 00437 CALL Read_Slab_From_Dataset_Double("pos_y0", & 00438 chandle%source_group_id, & 00439 dbl_buffer, & 00440 chandle%source_offset) 00441 00442 gravity_object%x0(2) = dbl_buffer(1) 00443 00444 CALL Read_Slab_From_Dataset_Double("pos_z0", & 00445 chandle%source_group_id, & 00446 dbl_buffer, & 00447 chandle%source_offset) 00448 00449 gravity_object%x0(3) = dbl_buffer(1) 00450 00451 00452 ! Read point gravity velocity variables. 00453 CALL Read_Slab_From_Dataset_Double("vel_x0", & 00454 chandle%source_group_id, & 00455 dbl_buffer, & 00456 chandle%source_offset) 00457 00458 gravity_object%v0(1) = dbl_buffer(1) 00459 00460 CALL Read_Slab_From_Dataset_Double("vel_y0", & 00461 chandle%source_group_id, & 00462 dbl_buffer, & 00463 chandle%source_offset) 00464 00465 gravity_object%v0(2) = dbl_buffer(1) 00466 00467 CALL Read_Slab_From_Dataset_Double("vel_z0", & 00468 chandle%source_group_id, & 00469 dbl_buffer, & 00470 chandle%source_offset) 00471 00472 gravity_object%v0(3) = dbl_buffer(1) 00473 00474 00475 ! Point gravity time variable. 00476 CALL Read_Slab_From_Dataset_Double("t0", & 00477 chandle%source_group_id, & 00478 dbl_buffer, & 00479 chandle%source_offset) 00480 00481 gravity_object%t0 = dbl_buffer(1) 00482 00483 CALL Read_Slab_From_Dataset_Double("mass", & 00484 chandle%source_group_id, & 00485 dbl_buffer, & 00486 chandle%source_offset) 00487 00488 gravity_object%mass = dbl_buffer(1) 00489 00490 CALL Read_Slab_From_Dataset_Double("soft_length", & 00491 chandle%source_group_id, & 00492 dbl_buffer, & 00493 chandle%source_offset) 00494 00495 gravity_object%soft_length = dbl_buffer(1) 00496 00497 CALL Read_Slab_From_Dataset_Int("soft_function", & 00498 chandle%source_group_id, & 00499 int_buffer, & 00500 chandle%source_offset) 00501 00502 gravity_object%soft_function = int_buffer(1) 00503 00504 CALL Read_Slab_From_Dataset_Int("id", & 00505 chandle%source_group_id, & 00506 int_buffer, & 00507 chandle%source_offset) 00508 00509 gravity_object%id = int_buffer(1) 00510 00511 chandle%source_offset = chandle%source_offset + 1 00512 00513 END SUBROUTINE PointGravity_ReadObjectFromChombo 00514 00515 END MODULE PointGravitySrc