Scrambler  1
Marquee/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 Marquee 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 GlobalDeclarations
00038    USE PhysicsDeclarations
00039    USE Ambients
00040    IMPLICIT NONE    ! It's safer to require explicit declarations
00041    SAVE             ! Save module information
00042    PRIVATE          ! Everything is implicitly private, i.e. accessible only
00043    ! to this module.
00044    PUBLIC :: ProblemModuleInit,ProblemGridInit,ProblemBeforeStep, ProblemAfterStep, ProblemSetErrFlag, ProblemBeforeGlobalStep
00045    REAL(KIND=qprec) :: ybounds(2), textspeed, backtextspeed, indexspeed, tstart, contrast, messagedx, rhoBackground, 
00046         EnergyBackground, drho, dp, de, rhoMessage, EnergyMessage, period, dv, yperiod, ydv
00047    INTEGER(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: message
00048    NAMELIST/ProblemData/ybounds, textspeed, backtextspeed, tstart, contrast, rhoBackGround, period, dv, yperiod, ydv
00049    INTEGER :: msize(2)
00050    REAL(KIND=qPREC) :: rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00051 
00052 CONTAINS
00053 
00055    SUBROUTINE ProblemModuleInit
00056       INTEGER :: iErr, i
00057       character(50) :: x
00058       TYPE(AmbientDef), POINTER :: Ambient
00059       NAMELIST /AmbientData/ rhoOut, pOut, vxOut, vyOut, vzOut, BxOut, ByOut, BzOut
00060 
00061       OPEN(UNIT=PROBLEM_DATA_HANDLE,FILE='problem.data',STATUS='old',      &
00062            FORM='formatted')
00063       READ(PROBLEM_DATA_HANDLE,NML=ProblemData)
00064       CALL CreateAmbient(Ambient)
00065       READ(PROBLEM_DATA_HANDLE,NML=AmbientData)
00066       Ambient%density=rhoOut
00067       Ambient%pressure=pOut
00068       Ambient%B(:)=(/BxOut, ByOut, BzOut/)
00069       Ambient%velocity(:)=(/vxOut, vyOut, vzOut/)
00070 
00071       CLOSE(PROBLEM_DATA_HANDLE)
00072       OPEN(UNIT=PROBLEM_DATA_HANDLE, FILE='message.data', STATUS='old')
00073       READ(PROBLEM_DATA_HANDLE,*) msize
00074       !     write(*,*) "Message size=", msize
00075       ALLOCATE(message(PROBLEM_DATA_HANDLE+msize(1),msize(2)))
00076       message(1:10,:)=0
00077       write(x,'(A1,I10,A3)') "(",size(message,1),"I1)"
00078       write(*,*) x
00079       DO i=1,msize(2)
00080          READ(PROBLEM_DATA_HANDLE,x) message(11:,msize(2)+1-i)
00081       END DO
00082       CLOSE(PROBLEM_DATA_HANDLE)
00083       messagedx=(ybounds(2)-ybounds(1))/msize(2)
00084       indexspeed=textspeed/messagedx      
00085       !      rhoBackground=rhoOut
00086       EnergyBackground=gamma7*pOut+half*rhoBackGround*backtextspeed**2
00087       rhoMessage=rhoBackground*contrast
00088 
00089       EnergyMessage=gamma7*pOut+half*rhoMessage*textspeed**2
00090 
00091       drho=rhoMessage-rhoBackground
00092       dp=-(rhoMessage*textspeed)+(rhoBackground*backtextspeed)
00093       write(*,'(5E13.2)') rhoMessage, textspeed, rhoBackground, backtextspeed, dp
00094       dE=EnergyMessage-EnergyBackground
00095       write(*,*) drho, dp
00096       write(*,*) 
00097       write(*,*) (-rhoBackground*backtextspeed+dp)/(rhoBackGround+drho)
00098 
00099    END SUBROUTINE ProblemModuleInit
00100 
00103    SUBROUTINE ProblemGridInit(Info)
00104       ! Interface declarations
00105       TYPE (InfoDef) :: Info  ! Data associated with this grid
00106       CALL ProblemBeforeStep(Info)
00107    END SUBROUTINE ProblemGridInit
00108 
00111    SUBROUTINE ProblemBeforeStep(Info)
00112       ! Interface declarations
00113       TYPE (InfoDef) :: Info  ! Data associated with this grid
00114       REAL (KIND=qPrec), POINTER, DIMENSION (:,:,:,:)     :: q
00115       INTEGER :: i,j,k,mx,my,mz,rmbc,zrmbc,i0(2),j0(2), ii0, jj0, sample_res, ii, jj,level
00116       REAL(KIND=xprec) :: x,y,z,xl,yl,zl,dx,dy,dz,timeyr, xpos, xbounds(2), overlapxbounds(2), 
00117            overlapybounds(2), fact, pos(2)
00118       !
00119       level=Info%level
00120       q=>Info%q
00121       rmbc=levels(level)%gmbc(1)
00122 
00123 
00124       mx=Info%mX(1); my=Info%mX(2); mz=Info%mX(3)
00125       dx=levels(level)%dX; xl=Info%XBounds(1,1);yl=Info%xBounds(2,1)
00126 
00127       !xposition of start of marqui
00128       xpos=GxBounds(1,2)-textspeed*(levels(level)%tnow-tstart)
00129       !      write(*,*) "xpos= ", xpos
00130       !x bounds of launch region
00131       xbounds(1)=max(xpos, GxBounds(1,2))
00132       xbounds(2)=min(xpos+msize(1)*messagedx, GxBounds(1,2)+levels(ROOT_LEVEL)%gmbc(1)*levels(ROOT_LEVEL)%dX)
00133 
00134       !overlap physical bounds of launch region with extended grid
00135       overlapxbounds(1)=max(xbounds(1),Info%xBounds(1,1)-rmbc*levels(level)%dx)
00136       overlapxbounds(2)=min(xbounds(2),Info%xBounds(1,1)+(Info%mX(1)+rmbc)*levels(level)%dx)
00137       overlapybounds(1)=max(ybounds(1),Info%xBounds(2,1)-rmbc*levels(level)%dx)
00138       overlapybounds(2)=min(ybounds(2),Info%xBounds(2,1)+(Info%mX(2)+rmbc)*levels(level)%dx)
00139       sample_res=max(nint(levels(level)%dx/messagedx),8)
00140       fact=1d0/real(sample_res)**2
00141       !      write(*,'(A,4E13.4)') "overlapbounds=", overlapxbounds, overlapybounds
00142       !      write(*,*) "sample_res=", sample_res
00143       IF (overlapxbounds(2) >= overlapxbounds(1) .AND. overlapybounds(2) >= overlapybounds(1)) THEN
00144 
00145          i0(1)=max(1-rmbc, ceiling((overlapxbounds(1)-Info%xBounds(1,1))/levels(level)%dx)) !max(product(coarsenratio(0:Info%level-1))-Info%mGlobal(1,1)+1, 1-rmbc)
00146          i0(2)=min(Info%mX(1)+rmbc, floor((overlapxbounds(2)-Info%xBounds(1,1))/levels(level)%dx))
00147          j0(1)=max(1-rmbc, ceiling((overlapybounds(1)-Info%xBounds(2,1))/levels(level)%dx)) !max(product(coarsenratio(0:Info%level-1))-Info%mGlobal(1,1)+1, 1-rmbc)
00148          j0(2)=min(Info%mX(2)+rmbc, floor((overlapybounds(2)-Info%xBounds(2,1))/levels(level)%dx))
00149          !         write(*,'(A,4I)') "i0,j0= ", i0,j0
00150          IF (i0(1) <= i0(2) .AND. j0(1) <= j0(2)) THEN !zero out overlap region with background values
00151             q(i0(1):i0(2),j0(1):j0(2),1,:) = 0
00152             q(i0(1):i0(2),j0(1):j0(2),1,1) = rhoBackground
00153             q(i0(1):i0(2),j0(1):j0(2),1,2) = -Backtextspeed*rhoBackGround
00154             !            q(:,:,:,1,2)=-Backtextspeed*rhoBackGround
00155             !            write(*,*) -Backtextspeed*rhoBackGround
00156             !            IF (iE .ne. 0) q(i0(1):i0(2),j0(1):j0(2),:,1,iE) = gamma7*pOut!EnergyBackground
00157             !            return
00158             DO i=i0(1),i0(2)
00159                DO j=j0(1),j0(2)
00160                   DO ii=1,sample_res
00161                      DO jj=1,sample_res
00162                         pos=Info%xBounds(1:2,1)+((real((/i,j/))-1d0) + 
00163                              ((/REAL(ii,8),REAL(jj,8)/)-half)/REAL(sample_res,8))*levels(level)%dX 
00164                         ii0=nint((pos(1)-xpos)/messagedx)
00165                         jj0=nint((pos(2)-ybounds(1))/messagedx)
00166                         IF (ii0 >= 1 .AND. ii0 <= msize(1) .AND. jj0 >= 1 .AND. jj0 <= msize(2)) THEN
00167                            IF (message(ii0,jj0)==1) THEN
00168                               q(i,j,1,1)=q(i,j,1,1)+drho*fact
00169                               dp=-(rhoMessage*textspeed*(1d0+dv*cos(2d0*Pi*levels(level)%tnow/period))) + &
00170                                    (rhoBackground*backtextspeed)
00171                               q(i,j,1,3)=q(i,j,1,3)+rhoMessage*textspeed*ydv*sin(2d0*Pi*levels(level)%tnow/yperiod)*fact
00172                               q(i,j,1,2)=q(i,j,1,2)+dp*fact
00173                               !                              IF (iE .ne. 0) q(i,j,1,1,iE)=q(i,j,1,1,iE)+de*fact                     
00174                            END IF
00175                         END IF
00176                      END DO
00177                   END DO
00178                   IF (iE .ne. 0) q(i,j,1,iE)= gamma7*pOut+half*SUM(q(i,j,1,2:3)**2)/q(i,j,1,1)
00179                END DO
00180             END DO
00181          END IF
00182       END IF
00183    END SUBROUTINE ProblemBeforeStep
00184 
00187    SUBROUTINE ProblemAfterStep(Info)
00188       !! @brief Performs any post-step corrections that are required.
00189       !! @param Info A grid structure.  
00190       TYPE (InfoDef) :: Info
00191    END SUBROUTINE ProblemAfterStep
00192 
00195    SUBROUTINE ProblemSetErrFlag(Info)
00196       !! @brief Sets error flags according to problem-specific conditions..
00197       !! @param Info A grid structure.  
00198       TYPE (InfoDef) :: Info
00199    END SUBROUTINE ProblemSetErrFlag
00200 
00201    SUBROUTINE ProblemBeforeGlobalStep(n)
00202       INTEGER :: n
00203    END SUBROUTINE ProblemBeforeGlobalStep
00204 
00205 
00206 END MODULE Problem
00207 
 All Classes Files Functions Variables