Scrambler
1
|
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