Scrambler  1
Binary/problem.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 !    problem.f90 of module Binary 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 
00028 
00032 
00035 MODULE Problem
00036   USE DataDeclarations
00037   USE ParticleDeclarations
00038   USE Ambients
00039   USE Disks
00040   USE Winds
00041   IMPLICIT NONE
00042   SAVE
00043   PUBLIC ProblemModuleInit, ProblemGridInit, &
00044        ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep
00045   REAL(KIND=qPREC) :: alpha, densw, velw, t1, t2
00046   INTEGER :: radiusw, nWinds
00047   LOGICAL :: windsPresent=.false., disk=.false.
00048   !TYPE(pWindDef), DIMENSION(:), ALLOCATABLE :: MyWinds
00049 
00050 CONTAINS
00051 
00053    SUBROUTINE ProblemModuleInit()      
00054       TYPE(InfoDef) :: Info
00055                 TYPE(WindDef), POINTER :: Wind
00056       INTEGER :: nParticles, edge
00057       REAL(KIND=qPREC) :: mass=0
00058       REAL(KIND=qPREC) :: xloc(3)
00059       REAL(KIND=qPREC) :: vel(3)
00060       TYPE(ParticleDef), POINTER :: Particle
00061                 TYPE(ParticleListDef), POINTER :: particlelist
00062       INTEGER :: i, grav_soft_rad
00063       INTEGER :: ids(2)
00064       TYPE(AmbientDef), POINTER :: Ambient
00065       TYPE(DiskDef), POINTER :: mydisk
00066       REAL(KIND=qPREC) :: time, rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut, 
00067                    buff(17) 
00068       NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00069       NAMELIST /ProblemData/ nParticles, densw, velw, windsPresent, disk, t1, t2
00070       NAMELIST /ParticleData/ mass,xloc,vel,alpha,radiusw,grav_soft_rad, buff
00071       NAMELIST /RestartData/ ids
00072 
00073 !      time=levels(Info%level)%tnow
00074 
00075       OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD")
00076       READ(PROBLEM_DATA_HANDLE,NML=ProblemData)
00077 
00078 if (.not. lrestart) then                
00079       CALL CreateAmbient(Ambient)
00080       READ(PROBLEM_DATA_HANDLE,NML=AmbientData)
00081       if (disk) then
00082                    Ambient%density=1d0
00083                 else ; Ambient%density=rhoOut
00084                 end if
00085       Ambient%pressure=Ambient%density
00086       Ambient%B(:)=(/BxOut, ByOut, BzOut/)
00087       Ambient%velocity(:)=(/vxOut, vyOut, vzOut/)
00088 end if      
00089 
00090 if (windsPresent) then
00091    DO i=1,nDim
00092       DO edge=1,2
00093          IF (Gmthbc(i,edge) == 1) THEN 
00094             NULLIFY(Wind)
00095             CALL CreateWind(Wind)
00096             Wind%dir=i
00097             Wind%edge=edge
00098                                 Wind%type=OUTFLOW_ONLY
00099          END IF
00100       END DO
00101    END DO
00102 !  ALLOCATE(MyWinds(6))
00103 !  nWinds=0
00104 !  DO i=1,nDim
00105 !     DO edge=1,2
00106 !        IF (Gmthbc(i,edge) == 1) THEN 
00107 !           nWinds=nWinds+1
00108 !           CALL CreateWind(MyWinds(nWinds)%p)
00109 !           MyWinds(nWinds)%p%dir=i
00110 !           MyWinds(nWinds)%p%edge=edge
00111 !                       MyWinds(nWinds)%p%type=OUTFLOW_ONLY
00112 !        END IF
00113 !     END DO
00114 !  END DO
00115 end if
00116                 
00117      IF (lRestart) THEN
00118        particleList=>SinkParticles
00119                  i=1
00120        DO WHILE (ASSOCIATED(particlelist))
00121           particle=>particlelist%self
00122           READ(PROBLEM_DATA_HANDLE,NML=ParticleData)
00123 
00124           if (i==1) then
00125                             Particle%PointGravityObj%soft_length=REAL(grav_soft_rad,qPREC)*sink_dx
00126                             Particle%PointGravityObj%alpha = alpha
00127                 if (alpha==0d0) then 
00128                                        Particle%iAccrete=NOACCRETION
00129                 else 
00130                                        Particle%iAccrete=KRUMHOLZ_ACCRETION
00131                                             ! see particle_declarations
00132                                     end if
00133                          end if
00134       
00135                  !if (time.ge.t1   .and.   time.le.t2) then
00136                            !   Particle%PointGravityObj%alpha = alpha*(time-t1)/(t2-t1) ! (0,1)
00137                            !else ; Particle%PointGravityObj%alpha = 0d0
00138                            !end if
00139 
00140                          IF (i==2) THEN
00141              CALL CreateOutflowObject(Particle%OutflowObj)
00142              Particle%OutflowObj%duration                               = 1.e30
00143              Particle%OutflowObj%radius                                 =REAL(radiusw,qPREC)*sink_dx
00144              Particle%OutflowObj%thickness                              =REAL(radiusw,qPREC)*sink_dx
00145              Particle%OutflowObj%open_angle                     = Pi
00146              Particle%OutflowObj%density                                = densw
00147              Particle%OutflowObj%temperature                    = 1d0
00148              Particle%OutflowObj%velocity                               = velw
00149              Particle%OutflowObj%source_vel(1:nDim)     = Particle%Q(imom(1:nDim))
00150              Particle%OutflowObj%position= Particle%xloc
00151              CALL UpdateOutflow(Particle%OutflowObj)
00152           END IF
00153           particlelist=>particlelist%next
00154                          i=i+1
00155        END DO
00156 
00157      ELSE!lrestart
00158 
00159          DO i=1,nParticles
00160             READ(PROBLEM_DATA_HANDLE,NML=ParticleData)
00161             NULLIFY(Particle)
00162             CALL CreateParticle(Particle)
00163             Particle%Q(1)=mass
00164             Particle%xloc=xloc
00165             Particle%Q(imom(1:nDim))=vel(1:nDim)
00166             Particle%Buffer=buff
00167             CALL AddSinkParticle(Particle)
00168              
00169                                 if (i==1) then
00170                               Particle%iAccrete=KRUMHOLZ_ACCRETION
00171                CALL CreatePointGravityObject(Particle%PointGravityObj)
00172                               Particle%PointGravityObj%alpha = alpha
00173                Particle%PointGravityObj%soft_length     =       REAL(grav_soft_rad,qPREC)*sink_dx
00174                Particle%PointGravityObj%soft_function   =SPLINESOFT
00175                Particle%PointGravityObj%Mass                            =Particle%Q(1)
00176                Particle%PointGravityObj%v0(1:nDim)              =Particle%Q(imom(1:nDim))
00177                Particle%PointGravityObj%x0                              =Particle%xloc
00178             end if
00179 !
00180 !!!
00181 if (disk) then
00182 ALLOCATE(MyDisk)
00183 !               mydisk%HeightProfile=0
00184                 !mydisk%HeightProfile=1 !flared
00185       mydisk%soft_length=REAL(grav_soft_rad,qPREC)*sink_dx
00186       mydisk%soft_function=SPLINESOFT
00187       mydisk%density=densw
00188       mydisk%pressure=  &!mydisk%density
00189                                                                 Ambient%pressure
00190       mydisk%velocity=Particle%Q(imom(1:nDim))
00191       !
00192                    mydisk%theta=0d0 !5feb12
00193                    !mydisk%theta=10d0*(Pi/180d0) !4feb12
00194         !mydisk%theta=Pi*.5d0 !3feb12
00195                 !  
00196       mydisk%phi=0d0
00197       mydisk%position=Particle%xloc
00198       mydisk%thickness=0d0
00199       mydisk%radius=    2d0 !6dec
00200                                                         !1d0
00201                                                         !6d0*REAL(radiusw,qPREC)*sink_dx
00202                                !24d0*sink_dx
00203  !     if (.not.mydisk%HeightProfile) 
00204  mydisk%height=2d0*REAL(grav_soft_rad,qPREC)*sink_dx
00205       !mydisk%height=mydisk%radius*.1d0
00206       mydisk%central_mass=mass
00207       CALL UpdateDisk(mydisk)
00208 end if!lock 
00209 !!!
00210 !
00211             IF (i.eq.2) THEN
00212                CALL CreateOutflowObject(Particle%OutflowObj)
00213                Particle%OutflowObj%duration                             = 1.e30
00214                Particle%OutflowObj%radius                                       =REAL(radiusw,qPREC)*sink_dx
00215                Particle%OutflowObj%thickness                            =REAL(radiusw,qPREC)*sink_dx
00216                Particle%OutflowObj%open_angle                   = Pi
00217                Particle%OutflowObj%density                              = densw
00218                Particle%OutflowObj%temperature                  = 1d0
00219                Particle%OutflowObj%velocity                             = velw
00220                Particle%OutflowObj%source_vel(1:nDim)   = Particle%Q(imom(1:nDim))
00221                Particle%OutflowObj%position= Particle%xloc
00222                CALL UpdateOutflow(Particle%OutflowObj)
00223             END IF
00224          END DO
00225    END IF!lrestart=0/1
00226 CLOSE(PROBLEM_DATA_HANDLE)      
00227 
00228    END SUBROUTINE ProblemModuleInit
00229 
00232   SUBROUTINE ProblemGridInit(Info)
00233     TYPE(InfoDef) :: Info
00234   END SUBROUTINE ProblemGridInit
00235 
00238   SUBROUTINE ProblemBeforeStep(Info)
00239     TYPE(InfoDef) :: Info
00240    INTEGER :: i, nParticles, grav_soft_rad
00241    REAL(KIND=xprec) :: beta,time, mass, xloc(3), vel(3),buff(17)
00242         TYPE(ParticleListDef), POINTER :: particlelist
00243      TYPE(ParticleDef), POINTER :: Particle
00244           LOGICAL,SAVE :: lock=.false.
00245      NAMELIST /ProblemData/ nParticles, densw, velw, windsPresent, disk, t1, t2
00246      NAMELIST /ParticleData/ mass,xloc,vel,alpha,radiusw,grav_soft_rad, buff
00247 
00248      return
00249 
00250      time=levels(Info%level)%tnow
00251         if (time.lt.t1) then ; return
00252           else if (time.ge.t1   .and.   time.le.t2) then
00253              beta = (time-t1)/(t2-t1) ! 0<= beta <=1
00254           else ; beta=1d0
00255           end if
00256 
00257            OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='problem.data', STATUS="OLD")
00258               READ(PROBLEM_DATA_HANDLE,NML=ProblemData)
00259                  particleList=>SinkParticles
00260                  i=1
00261                  DO WHILE (ASSOCIATED(particlelist))
00262                     particle=>particlelist%self
00263                     READ(PROBLEM_DATA_HANDLE,NML=ParticleData)
00264                               if (i==1) then
00265                                          Particle%PointGravityObj%alpha =alpha*beta
00266                           !print*,'t1,t2i,a*b=',t1,t2,i,alpha*beta
00267                                            end if
00268                        particlelist=>particlelist%next
00269                    i=i+1
00270                  END DO
00271            CLOSE(PROBLEM_DATA_HANDLE)      
00272    
00273               if (time.gt.t2   .and.   Particle%PointGravityObj%alpha.eq.1d0) lock=.true.
00274 
00275   END SUBROUTINE ProblemBeforeStep
00276 
00279   SUBROUTINE ProblemAfterStep(Info)
00280     TYPE(InfoDef) :: Info
00281   END SUBROUTINE ProblemAfterStep
00282 
00285   SUBROUTINE ProblemSetErrFlag(Info)
00286     TYPE(InfoDef) :: Info
00287   END SUBROUTINE ProblemSetErrFlag
00288 
00289   SUBROUTINE ProblemBeforeGlobalStep(n)
00290      INTEGER :: n
00291   END SUBROUTINE ProblemBeforeGlobalStep
00292 
00293 END MODULE Problem
00294 
 All Classes Files Functions Variables