Scrambler  1
pointgravity.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 !    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
 All Classes Files Functions Variables