Scrambler  1
uniformregions.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 !    uniformregions.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 !#########################################################################
00025 
00029 
00032 
00036 
00039 MODULE Uniformregions
00040   USE GlobalDeclarations
00041   USE DataDeclarations
00042   USE PhysicsDeclarations
00043   USE DataInfoOps
00044   USE Shapes
00045   USE ObjectDeclarations
00046   IMPLICIT NONE
00048   TYPE UniformRegionDef
00049      TYPE(ShapeDef), POINTER :: Shape => null()
00050      REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: q
00051      INTEGER :: SubSample=1
00052      LOGICAL :: PersistInBoundaries(3,2) = .false.
00053      LOGICAL :: PersistInternal = .false.
00054      INTEGER :: ObjId
00055   END TYPE UniformRegionDef
00056 
00057   !new declaration
00058   TYPE pUniformRegionDef
00059     TYPE(UniformRegionDef), POINTER :: ptr
00060   END TYPE pUniformRegionDef
00061     TYPE(pUniformRegionDef) :: pUniformRegion
00062   !
00063  
00064   !TYPE(UniformRegionDef), POINTER :: FirstUniformRegion, LastUniformRegion
00065   SAVE
00066 CONTAINS
00067 
00068 
00071    SUBROUTINE CreateUniformRegion(UniformRegion, Shape)
00072       TYPE(UniformRegionDef), POINTER :: UniformRegion
00073       TYPE(ShapeDef), POINTER, OPTIONAL :: Shape
00074       ALLOCATE(UniformRegion)
00075       IF (Present(Shape)) THEN
00076         UniformRegion%Shape => Shape
00077       ELSE
00078         ALLOCATE(UniformRegion%Shape)
00079       ENDIF
00080       ALLOCATE(UniformRegion%q(NrHydroVars))
00081       CALL AddUniformRegionToList(UniformRegion)
00082    END SUBROUTINE CreateUniformRegion
00083 
00084    SUBROUTINE UpdateUniformRegion(UniformRegion)
00085     TYPE(UniformRegionDef), POINTER :: UniformRegion
00086     !update attributes that needs to be updated,
00087     !if any
00088    END SUBROUTINE UpdateUniformRegion
00089 
00090    SUBROUTINE AddUniformRegionToList(UniformRegion)
00091       TYPE(UniformRegionDef), POINTER :: UniformRegion
00092       TYPE(ObjectDef), POINTER :: Object
00093       UniformRegion%ObjId = ObjectListAdd(Object,UniformRegionOBJ)
00094       pUniformRegion%ptr => UniformRegion
00095       len = size(transfer(pUniformRegion, dummy_char))
00096       ALLOCATE(Object%storage(len))
00097       Object%storage = transfer(pUniformRegion,Object%storage)
00098    END SUBROUTINE AddUniformRegionToList
00099 
00100 
00101   SUBROUTINE DestroyUniformRegionObject(UniformRegionObj)
00102     TYPE(UniformRegionDef),POINTER :: UniformRegionObj
00103     CALL ObjectListRemove(UniformRegionObj%ObjId)
00104     DEALLOCATE(UniformRegionObj%q)
00105     DEALLOCATE(UniformRegionObj%Shape)
00106     DEALLOCATE(UniformRegionObj)
00107     NULLIFY(UniformRegionObj)
00108   END SUBROUTINE DestroyUniformRegionObject
00109 
00110 
00111 
00112    SUBROUTINE UniformRegionGridInit(Info, UniformRegion)
00113      TYPE(InfoDef) :: Info
00114      TYPE(UniformRegionDef), POINTER :: UniformRegion
00115      INTEGER, POINTER, DIMENSION(:,:,:) :: mSs
00116      REAL(KIND=qPREC), POINTER, DIMENSION(:,:) :: offsets
00117      INTEGER :: nOverlaps
00118      CALL CalcPhysicalOverlaps(Info, UniformRegion%Shape%xBounds, mSs, nOverlaps, offsets, IEVERYWHERE, lHydroPeriodic)
00119      IF (nOverlaps > 0) THEN
00120         CALL PlaceUniformRegion(Info, UniformRegion, nOverlaps, mSs, offsets)
00121         DEALLOCATE(mSs, offsets)
00122      END IF
00123    END SUBROUTINE UniformRegionGridInit
00124 
00125 
00126    SUBROUTINE UniformRegionBeforeStep(Info, UniformRegion)
00127      TYPE(InfoDef) :: Info
00128      TYPE(UniformRegionDef), POINTER :: UniformRegion
00129      INTEGER, POINTER, DIMENSION(:,:,:) :: mSs
00130      REAL(KIND=qPREC), POINTER, DIMENSION(:,:) :: offsets
00131      INTEGER :: nOverlaps
00132      INTEGER :: i,j
00133      DO i=1,nDim
00134         DO j=1,2
00135            IF (UniformRegion%PersistInBoundaries(i,j)) THEN
00136               CALL CalcPhysicalOverlaps(Info, UniformRegion%Shape%xBounds, mSs, nOverlaps, offsets, IBOUNDARY(i,j), lHydroPeriodic)
00137               IF (nOverlaps > 0) THEN
00138                  CALL PlaceUniformRegion(Info, UniformRegion, nOverlaps, mSs, offsets)
00139                  DEALLOCATE(mSs, offsets)
00140               END IF
00141            END IF
00142         END DO
00143      END DO
00144    END SUBROUTINE UniformRegionBeforeStep
00145 
00146    SUBROUTINE UniformRegionSetErrFlag(Info, UniformRegion)
00147       TYPE(InfoDef) :: Info
00148       Type(UniformRegionDef), POINTER :: UniformRegion
00149    END SUBROUTINE UniformRegionSetErrFlag
00150 
00151    SUBROUTINE UniformRegionBeforeGlobalStep(n)
00152       INTEGER :: n
00153    END SUBROUTINE UniformRegionBeforeGlobalStep 
00154 
00155   SUBROUTINE PlaceUniformRegion(Info, UniformRegion, nOverlaps, mSs, offsets)
00156      TYPE(InfoDef) :: Info
00157      Type(UniformRegionDef) :: UniformRegion
00158      INTEGER :: i,j,k,n,m,ii,jj,kk, location
00159      INTEGER, DIMENSION(3,2) :: mS    
00160      INTEGER, POINTER, DIMENSION(:,:,:) :: mSs
00161      REAL(KIND=qPREC), DIMENSION(3) :: offset
00162      REAL(KIND=qPREC), POINTER, DIMENSION(:,:) :: offsets
00163      REAL(KIND=qPREC), DIMENSION(3) :: xpos, pos,coords
00164      REAL(KIND=qPREC) :: sample_fact(3), q_fact, dx, xBounds(3,2)
00165      INTEGER :: sample_res(3), nOverlaps
00166      REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: q_source
00167 
00168      dx=levels(Info%level)%dX
00169      xpos=0          
00170      IF (nOverlaps > 0) THEN
00171         sample_res=1
00172         sample_fact=0d0
00173         sample_res(1:nDim)=UniformRegion%SubSample!min(2**(MaxLevel-Info%level),4)
00174         sample_fact(1:nDim)=1d0/REAL(sample_res(1:nDim),8)
00175         q_fact=product(sample_fact(1:nDim))
00176         ALLOCATE(q_Source(NrHydroVars))
00177         DO n=1,nOverlaps
00178            mS=mSs(n,:,:)
00179            offset=offsets(n,:)
00180            ! Now set up cell centered quantities (density and momentum)
00181            DO k=mS(3,1),mS(3,2)
00182               xpos(3)=Info%xBounds(3,1)+offset(3)+(k-1)*dx
00183               DO j=mS(2,1),mS(2,2)
00184                  xpos(2)=Info%xBounds(2,1)+offset(2)+(j-1)*dx
00185                  DO i=mS(1,1),mS(1,2)
00186                     xpos(1)=Info%xBounds(1,1)+offset(1)+(i-1)*dx
00187                     q_Source=0
00188                     DO kk=1,sample_res(3)
00189                        pos(3)=xpos(3)+(REAL(kk, 8)-half)*dx*sample_fact(3)
00190                        DO jj=1,sample_res(2)
00191                           pos(2)=xpos(2)+(REAL(jj, 8)-half)*dx*sample_fact(2)
00192                           DO ii=1,sample_res(1)
00193                              pos(1)=xpos(1)+(REAL(ii, 8)-half)*dx*sample_fact(1)
00194                              IF (IsInShape(UniformRegion%Shape, pos, coords)) THEN
00195                                 q_source=q_source+(UniformRegion%q-Info%q(i,j,k,1:NrHydroVars))
00196                              END IF
00197                           END DO
00198                        END DO
00199                     END DO
00200                     Info%q(i,j,k,1:NrHydroVars)=Info%q(i,j,k,1:NrHydroVars)+q_source*q_fact                 
00201                  END DO
00202               END DO
00203            END DO
00204         END DO
00205         DEALLOCATE(q_Source)
00206      END IF
00207 
00208 
00209   END SUBROUTINE PlaceUniformRegion
00210 
00211 END MODULE UniformRegions
00212 
00213 
 All Classes Files Functions Variables