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