Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! collidingflows.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 CollidingFlows 00040 USE GlobalDeclarations 00041 USE DataDeclarations 00042 USE PhysicsDeclarations 00043 USE DataInfoOps 00044 USE Shapes 00045 USE Interfaces 00046 USE CommonFunctions 00047 USE EOS 00048 USE ObjectDeclarations 00049 IMPLICIT NONE 00051 TYPE CollidingFlowDef 00052 REAL(KIND=qPREC) :: density 00053 REAL(KIND=qPREC) :: velocity 00054 REAL(KIND=qPREC) :: temperature 00055 REAL(KIND=qPREC), DIMENSION(3) :: B=0 00056 TYPE(ShapeDef), POINTER :: shape => null() 00057 TYPE(InterfaceDef), POINTER :: InterfaceObj => null() 00058 REAL(KIND=qPREC) :: smooth_distance=0 00059 INTEGER :: smooth_function=0 00060 REAL(KIND=qPREC) :: interface_dist=0 00061 INTEGER :: interface_func=0 00062 INTEGER :: iTracer(2) = 0 00063 INTEGER :: SubSample=1 00064 LOGICAL :: PersistInBoundaries(3,2) = .false. 00065 LOGICAL :: PersistInternal = .false. 00066 REAL(KIND=qPREC) :: tShutOff = 1e30 00067 REAL(KIND=qPREC) :: RampTime = 1 00068 INTEGER :: ObjId 00069 END TYPE CollidingFlowDef 00070 00071 !new declaration 00072 TYPE pCollidingFlowDef 00073 TYPE(CollidingFlowDef), POINTER :: ptr 00074 END TYPE pCollidingFlowDef 00075 TYPE(pCollidingFlowDef) :: pCollidingFlow 00076 ! 00077 00078 SAVE 00079 CONTAINS 00080 00081 ! 00084 SUBROUTINE CreateCollidingFlow(CollidingFlow, density, temperature, velocity) 00085 TYPE(CollidingFlowDef), POINTER :: CollidingFlow 00086 REAL(KIND=qPREC), OPTIONAL :: density, temperature, velocity 00087 ALLOCATE(CollidingFlow) 00088 ALLOCATE(CollidingFlow%InterfaceObj) 00089 ALLOCATE(CollidingFlow%Shape) 00090 IF (Present(density)) CollidingFlow%density=density 00091 IF (Present(temperature)) CollidingFlow%temperature=temperature 00092 IF (Present(velocity)) CollidingFlow%velocity=velocity 00093 CALL addcollidingFlowToList(CollidingFlow) 00094 END SUBROUTINE CreateCollidingFlow 00095 00096 SUBROUTINE UpdateCollidingFlow(CollidingFlow) 00097 TYPE(CollidingFlowDef), POINTER :: CollidingFlow 00098 !update attributes that needs to be updated, if any 00099 END SUBROUTINE UpdateCollidingFlow 00100 00101 00102 SUBROUTINE AddCollidingFlowToList(CollidingFlow) 00103 TYPE(CollidingFlowDef), POINTER :: CollidingFlow 00104 TYPE(ObjectDef), POINTER :: Object 00105 CollidingFlow%ObjId = ObjectListAdd(Object,COLLIDINGFLOWOBJ) 00106 pCollidingFlow%ptr => CollidingFlow 00107 len = size(transfer(pCollidingFlow, dummy_char)) 00108 ALLOCATE(Object%storage(len)) 00109 Object%storage = transfer(pCollidingFlow, Object%storage) 00110 END SUBROUTINE AddCollidingFlowToList 00111 00112 00113 SUBROUTINE DestroyCollidingFlowObject(CollidingFlow) 00114 TYPE(CollidingFlowDef),POINTER :: CollidingFlow 00115 CALL ObjectListRemove(CollidingFlow%ObjId) 00116 DEALLOCATE(CollidingFlow%Shape) 00117 CALL DestroyInterface(CollidingFlow%InterfaceObj) 00118 DEALLOCATE(CollidingFlow) 00119 NULLIFY(CollidingFlow) 00120 END SUBROUTINE DestroyCollidingFlowObject 00121 00122 00123 00124 SUBROUTINE CollidingFlowGridInit(Info, CollidingFlow) 00125 TYPE(InfoDef) :: Info 00126 TYPE(CollidingFlowDef), POINTER :: CollidingFlow 00127 INTEGER, POINTER, DIMENSION(:,:,:) :: mSs 00128 REAL(KIND=qPREC), POINTER, DIMENSION(:,:) :: offsets 00129 INTEGER :: nOverlaps 00130 CALL CalcPhysicalOverlaps(Info, CollidingFlow%Shape%xBounds, mSs, nOverlaps, offsets, IEVERYWHERE, lHydroPeriodic) 00131 IF (nOverlaps > 0) THEN 00132 CALL PlaceCollidingFlow(Info, CollidingFlow, nOverlaps, mSs, offsets) 00133 DEALLOCATE(mSs, offsets) 00134 END IF 00135 END SUBROUTINE CollidingFlowGridInit 00136 00137 00138 SUBROUTINE CollidingFlowBeforeStep(Info, CollidingFlow) 00139 TYPE(InfoDef) :: Info 00140 TYPE(CollidingFlowDef), POINTER :: CollidingFlow 00141 INTEGER, POINTER, DIMENSION(:,:,:) :: mSs 00142 REAL(KIND=qPREC), POINTER, DIMENSION(:,:) :: offsets 00143 INTEGER :: nOverlaps 00144 INTEGER :: i,j 00145 DO i=1,nDim 00146 DO j=1,2 00147 IF (CollidingFlow%PersistInBoundaries(i,j)) THEN 00148 CALL CalcPhysicalOverlaps(Info, CollidingFlow%Shape%xBounds, mSs, nOverlaps, offsets, IBOUNDARY(i,j), lHydroPeriodic) 00149 IF (nOverlaps > 0) THEN 00150 CALL PlaceCollidingFlow(Info, CollidingFlow, nOverlaps, mSs, offsets) 00151 DEALLOCATE(mSs, offsets) 00152 END IF 00153 END IF 00154 END DO 00155 END DO 00156 END SUBROUTINE CollidingFlowBeforeStep 00157 00158 SUBROUTINE CollidingFlowSetErrFlag(Info, CollidingFlow) 00159 TYPE(InfoDef) :: Info 00160 Type(CollidingFlowDef), POINTER :: CollidingFlow 00161 END SUBROUTINE CollidingFlowSetErrFlag 00162 00163 00164 SUBROUTINE PlaceCollidingFlow(Info, CollidingFlow, nOverlaps, mSs, offsets) 00165 TYPE(InfoDef) :: Info 00166 Type(CollidingFlowDef) :: CollidingFlow 00167 INTEGER :: i,j,k,n,m,ii,jj,kk, location 00168 INTEGER, DIMENSION(3,2) :: mS 00169 INTEGER, POINTER, DIMENSION(:,:,:) :: mSs 00170 REAL(KIND=qPREC), DIMENSION(3) :: offset 00171 REAL(KIND=qPREC), POINTER, DIMENSION(:,:) :: offsets 00172 REAL(KIND=qPREC), DIMENSION(3) :: xpos, pos,coords,vel 00173 REAL(KIND=qPREC) :: sample_fact(3), q_fact, dx, r, fact, dz, dist 00174 INTEGER :: sample_res(3), nOverlaps 00175 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: q_source 00176 00177 dx=levels(Info%level)%dX 00178 dz=merge(dx, 0d0, nDim == 3) 00179 00180 xpos=0 00181 IF (nOverlaps > 0) THEN 00182 sample_res=1 00183 sample_fact=0d0 00184 IF (CollidingFlow%SubSample > 0) THEN 00185 sample_res(1:nDim)=CollidingFlow%SubSample !max(CollidingFlow%SubSample,2**(MaxLevel-Info%level)) 00186 END IF 00187 sample_fact(1:nDim)=1d0/REAL(sample_res(1:nDim),8) 00188 q_fact=product(sample_fact(1:nDim)) 00189 ALLOCATE(q_Source(NrHydroVars)) 00190 DO n=1,nOverlaps 00191 mS=mSs(n,:,:) 00192 offset=offsets(n,:) 00193 ! Now set up cell centered quantities (density and momentum) 00194 CALL ConvertTotalToInternalEnergy(Info%q(mS(1,1):mS(1,2), mS(2,1):mS(2,2),mS(3,1):mS(3,2),:)) 00195 DO k=mS(3,1),mS(3,2) 00196 xpos(3)=Info%xBounds(3,1)+offset(3)+(k-1)*dz 00197 DO j=mS(2,1),mS(2,2) 00198 xpos(2)=Info%xBounds(2,1)+offset(2)+(j-1)*dx 00199 DO i=mS(1,1),mS(1,2) 00200 xpos(1)=Info%xBounds(1,1)+offset(1)+(i-1)*dx 00201 q_Source=0 00202 DO kk=1,sample_res(3) 00203 pos(3)=xpos(3)+(REAL(kk, 8)-half)*dz*sample_fact(3) 00204 DO jj=1,sample_res(2) 00205 pos(2)=xpos(2)+(REAL(jj, 8)-half)*dx*sample_fact(2) 00206 DO ii=1,sample_res(1) 00207 pos(1)=xpos(1)+(REAL(ii, 8)-half)*dx*sample_fact(1) 00208 IF (IsInShape(CollidingFlow%Shape, pos, coords)) THEN 00209 q_source(1)=q_source(1)+CollidingFlow%density-Info%q(i,j,k,1) 00210 r=sqrt(sum(coords(1:2)**2/CollidingFlow%Shape%size_param(1:2)**2)) 00211 fact=SmoothFunction(r, CollidingFlow%smooth_function,CollidingFlow%smooth_distance/sqrt(sum(CollidingFlow%Shape%Size_param(1:2)**2))) 00212 vel=fact*CollidingFlow%velocity*RotateVectorFromShape(CollidingFlow%Shape, (/0d0,0d0,1d0/)) 00213 IF (levels(Info%level)%tnow > CollidingFlow%tShutOff) THEN 00214 IF (levels(Info%level)%tnow > CollidingFlow%tShutOff+CollidingFlow%RampTime) THEN 00215 vel=0d0 00216 ELSE 00217 vel=vel*(1d0-(levels(Info%level)%tnow - CollidingFlow%tShutOff)/CollidingFlow%RampTime) 00218 END IF 00219 END IF 00220 IF (iE .ne. 0) q_source(iE)=q_source(iE)+gamma7*CollidingFlow%density*CollidingFlow%Temperature - Info%q(i,j,k,iE) 00221 IF (IsAboveInterface(CollidingFlow%InterfaceObj, pos, dist)) THEN 00222 q_source(ivx:ivx+nDim-1)=q_source(ivx:ivx+nDim-1)-CollidingFlow%density*vel(1:nDim)*SmoothFunction(1d0-dist/CollidingFlow%interface_dist, CollidingFlow%interface_func, 1d0) -Info%q(i,j,k,ivx:ivx+nDim-1) 00223 IF (CollidingFlow%iTracer(1) /= 0) q_source(CollidingFlow%iTracer(1)) = q_source(CollidingFlow%iTracer(1)) + CollidingFlow%density- Info%q(i,j,k,CollidingFlow%iTracer(1)) 00224 IF (CollidingFlow%iTracer(2) /= 0) q_source(CollidingFlow%iTracer(2)) = q_source(CollidingFlow%iTracer(2)) + 0d0 - Info%q(i,j,k,CollidingFlow%iTracer(2)) 00225 ELSE 00226 q_source(ivx:ivx+nDim-1)=q_source(ivx:ivx+nDim-1)+CollidingFlow%density*vel(1:nDim)*SmoothFunction(1d0-dist/CollidingFlow%interface_dist, CollidingFlow%interface_func, 1d0)-Info%q(i,j,k,ivx:ivx+nDim-1) 00227 IF (CollidingFlow%iTracer(2) /= 0) q_source(CollidingFlow%iTracer(2)) = q_source(CollidingFlow%iTracer(2)) + CollidingFlow%density- Info%q(i,j,k,CollidingFlow%iTracer(2)) 00228 IF (CollidingFlow%iTracer(1) /= 0) q_source(CollidingFlow%iTracer(1)) = q_source(CollidingFlow%iTracer(1)) + 0d0 - Info%q(i,j,k,CollidingFlow%iTracer(1)) 00229 END IF 00230 IF (lMHD) THEN 00231 q_source(iBx:iBz)=CollidingFlow%B(:) 00232 END IF 00233 END IF 00234 END DO 00235 END DO 00236 END DO 00237 Info%q(i,j,k,1:NrHydroVars)=Info%q(i,j,k,1:NrHydroVars)+q_source*q_fact 00238 END DO 00239 END DO 00240 END DO 00241 CALL ConvertInternalToTotalEnergy(Info%q(mS(1,1):mS(1,2), mS(2,1):mS(2,2),mS(3,1):mS(3,2),:)) 00242 END DO 00243 DEALLOCATE(q_Source) 00244 END IF 00245 00246 END SUBROUTINE PlaceCollidingFlow 00247 00248 00249 00250 00251 END MODULE CollidingFlows 00252