Scrambler  1
outflow.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 !    outflow.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 !#########################################################################
00023 MODULE OutflowSrc
00024 
00025   USE DataDeclarations
00026   USE PhysicsDeclarations
00027   USE SourceDeclarations
00028 
00029   IMPLICIT NONE
00030   PRIVATE
00031 
00033   TYPE, PUBLIC :: OutflowDef
00034      REAL(KIND=xPrec)    :: pos(3),radius,v0(3),t0,mass,massloss
00035      REAL(KIND=xPrec)    :: outflow_vector(3)
00036      REAL(KIND=qPrec)    :: opening_angle
00037      REAL(KIND=qPrec)    :: massflux,momentumflux,energyflux
00038      REAL(KIND=xPrec)    :: precession_angle   ! used to update outflow_vector
00039      REAL(KIND=qPrec)    :: precession_rate    !   do precession
00040      LOGICAL             :: lBipolar
00041      REAL(KIND=qPrec)    :: tstart, tend, startinterval, endinterval
00042      INTEGER             :: starttype, endtype
00043      !
00044      INTEGER,DIMENSION(:),ALLOCATABLE :: iTracerFields,iEllipticFields,iDiagnosticFields     
00045      TYPE(OutflowDef),POINTER :: previous,next ! used to handle linked list of outflow objects
00046      INTEGER             :: ID
00047   END TYPE OutflowDef
00048 
00049   PUBLIC Outflows,CreateOutflowObject,DestroyOutflowObject,QueryOutflows,GetOutflowByID,OutflowsIO
00050 
00052   INTERFACE QueryOutflows
00053      MODULE PROCEDURE   queryInt, queryFloat, queryDouble, queryLogical, queryCh
00054   END INTERFACE
00055 
00056   ! parameters for start and end types
00057   INTEGER,PARAMETER :: instant=1,linear=2,exponential=3
00058 
00059   TYPE(OutflowDef),PUBLIC,POINTER :: FirstOutflow, LastOutflow
00060   INTEGER :: iOutflowID=0
00061 
00062 CONTAINS
00063 
00064 
00065 
00069   SUBROUTINE Outflows(q,dqdt,pos)
00070     ! Interface declarations
00071     REAL(KIND=qPrec) :: q(:),dqdt(:)
00072     ! Internal declarations
00073     TYPE(OutflowDef),POINTER :: outflow
00074     REAL(KIND=xPrec) :: outflowpos(3),radius
00075     REAL(KIND=xPrec) :: outflow_vector(3)
00076     REAL(KIND=qPrec) :: opening_angle
00077     REAL(KIND=qPrec) :: massflux,momentumflux,energyflux
00078     REAL(KIND=xPrec) :: precession_angle ! used to update outflow_vector
00079     REAL(KIND=qPrec) :: precession_rate  !   in order to do precession
00080     LOGICAL          :: lBipolar
00081     !
00082     INTEGER i
00083 
00084     outflow=>firstoutflow
00085     DO WHILE(ASSOCIATED(outflow))
00086        outflowpos       = outflow%pos
00087        radius           = outflow%radius
00088        outflow_vector   = outflow%outflow_vector
00089        opening_angle    = outflow%opening_angle
00090        massflux         = outflow%massflux
00091        momentumflux     = outflow%momentumflux
00092        energyflux       = outflow%energyflux
00093        precession_angle = outflow%precession_angle
00094        precession_rate  = outflow%precession_rate
00095        lBipolar         = outflow%lBipolar
00096 
00097        ! Update dqdt here
00098        ! ...
00099        ! ...
00100 
00101        outflow=>outflow%next
00102     END DO
00103           
00104   END SUBROUTINE Outflows
00105 
00106   ! ==========================================
00107   ! =      Outflow creation/destruction      =
00108   ! =      and list manipulation section     =
00109   ! ==========================================
00110 
00114   SUBROUTINE CreateOutflowObject(outflow,userid)
00115     ! Interface declarations
00116     TYPE(OutflowDef),POINTER :: outflow
00117     INTEGER,OPTIONAL :: userid
00118     ! Internal declarations
00119 
00120     IF(ASSOCIATED(outflow)) THEN
00121        PRINT*,'outflow_source.f90::CreateOutflowObject error -- outflow object already associated. Halting.'
00122        STOP
00123     END IF
00124 
00125     ALLOCATE(outflow)
00126     NULLIFY(outflow%previous)
00127     NULLIFY(outflow%next)
00128     IF(PRESENT(userid)) THEN
00129        outflow%ID=userid
00130     ELSE
00131        iOutflowID=iOutflowID+1 
00132        outflow%ID=iOutflowID
00133     END IF
00134     CALL AddOutflowToList(outflow)
00135   END SUBROUTINE CreateOutflowObject
00136 
00140   SUBROUTINE DestroyOutflowObject(outflow,id)
00141     ! Interface declarations
00142     TYPE(OutflowDef),POINTER :: outflow
00143     INTEGER,OPTIONAL :: id
00144     ! Internal declarations
00145 
00146     IF(PRESENT(id)) THEN
00147        outflow=>firstoutflow
00148        DO WHILE(ASSOCIATED(outflow))
00149           IF(outflow%id==id) THEN
00150              EXIT
00151           ELSE
00152              outflow=>outflow%next
00153           END IF
00154        END DO
00155     END IF
00156     CALL RemoveOutflowFromList(outflow)
00157     DEALLOCATE(outflow)
00158     NULLIFY(outflow)
00159   END SUBROUTINE DestroyOutflowObject
00160 
00163   SUBROUTINE AddOutflowToList(outflow)
00164     ! Interface declarations
00165     TYPE(OutflowDef),POINTER :: outflow
00166     ! Internal declarations
00167 
00168     IF(.NOT. ASSOCIATED(firstoutflow)) THEN    ! first outflow only
00169        firstoutflow=>outflow
00170        lastoutflow=>outflow
00171     ELSE
00172        outflow%previous=>lastoutflow
00173        lastoutflow%next=>outflow
00174        lastoutflow=>outflow
00175     END IF
00176   END SUBROUTINE AddOutflowToList
00177 
00180   SUBROUTINE RemoveOutflowFromList(outflow)
00181     ! Interface declarations
00182     TYPE(OutflowDef),POINTER :: outflow
00183     ! Internal declarations
00184 
00185     IF(ASSOCIATED(outflow%previous)) THEN
00186        outflow%previous%next=>outflow%next
00187     ELSE
00188        firstoutflow=>outflow%next
00189     END IF
00190 
00191     IF(ASSOCIATED(outflow%next)) THEN
00192        outflow%next%previous=>outflow%previous
00193     ELSE
00194        lastoutflow=>outflow%previous
00195        NULLIFY(lastoutflow%next)
00196     END IF
00197 
00198   END SUBROUTINE RemoveOutflowFromList
00199 
00200   SUBROUTINE GetOutflowByID(outflow,id)
00201     ! Interface declarations
00202     TYPE(OutflowDef),POINTER :: outflow
00203     INTEGER :: id
00204     ! Internal declarations
00205 
00206     outflow=>firstoutflow
00207     DO WHILE(ASSOCIATED(outflow))
00208        IF(outflow%id==id) EXIT
00209        outflow=>outflow%next
00210     END DO
00211   END SUBROUTINE GetOutflowByID
00212 
00213   ! ====================================
00214   ! =           Query section          =
00215   ! ====================================
00216 
00221   SUBROUTINE queryInt(queryChar,IDlist,iquery)
00222     ! Interface declarations
00223     CHARACTER(LEN=*) :: queryChar
00224     INTEGER,DIMENSION(:) :: IDlist
00225     INTEGER,DIMENSION(:) :: iquery
00226     ! Internal declarations
00227     TYPE(OutflowDef),POINTER :: currOutflow
00228     INTEGER :: i=0
00229     LOGICAL :: lMatch
00230     IDlist=0
00231     currOutflow=>firstoutflow
00232     DO WHILE(ASSOCIATED(currOutflow))
00233        CALL queryOutflow(currOutflow,lmatch,queryChar,iquery=iquery)
00234        IF(lmatch) THEN
00235           i=i+1
00236           IDlist(i)=curroutflow%id
00237        END IF
00238        currOutflow=>currOutflow%next
00239     END DO
00240   END SUBROUTINE queryInt
00241 
00246   SUBROUTINE queryFloat(queryChar,IDlist,fquery)
00247     ! Interface declarations
00248     CHARACTER(LEN=*) :: queryChar
00249     INTEGER,DIMENSION(:) :: IDlist
00250     REAL,DIMENSION(:) :: fquery
00251     ! Internal declarations
00252     TYPE(OutflowDef),POINTER :: currOutflow
00253     INTEGER :: i=0
00254     LOGICAL :: lMatch
00255     IDlist=0
00256     currOutflow=>firstoutflow
00257     DO WHILE(ASSOCIATED(currOutflow))
00258        CALL queryOutflow(currOutflow,lmatch,queryChar,fquery=fquery)
00259        IF(lmatch) THEN
00260           i=i+1
00261           IDlist(i)=curroutflow%id
00262        END IF
00263        currOutflow=>currOutflow%next
00264     END DO
00265   END SUBROUTINE queryFloat
00266 
00271   SUBROUTINE queryDouble(queryChar,IDlist,dquery)
00272     ! Interface declarations
00273     CHARACTER(LEN=*) :: queryChar
00274     INTEGER,DIMENSION(:) :: IDlist
00275     REAL(KIND=qPrec),DIMENSION(:) :: dquery
00276     ! Internal declarations
00277     TYPE(OutflowDef),POINTER :: currOutflow
00278     INTEGER :: i=0
00279     LOGICAL :: lMatch
00280     IDlist=0
00281     currOutflow=>firstoutflow
00282     DO WHILE(ASSOCIATED(currOutflow))
00283        CALL queryOutflow(currOutflow,lmatch,queryChar,dquery=dquery)
00284        IF(lmatch) THEN
00285           i=i+1
00286           IDlist(i)=curroutflow%id
00287        END IF
00288        currOutflow=>currOutflow%next
00289     END DO
00290   END SUBROUTINE queryDouble
00291 
00296   SUBROUTINE queryLogical(queryChar,IDlist,lquery)
00297     ! Interface declarations
00298     CHARACTER(LEN=*) :: queryChar
00299     INTEGER,DIMENSION(:) :: IDlist
00300     LOGICAL,DIMENSION(:) :: lquery
00301     ! Internal declarations
00302     TYPE(OutflowDef),POINTER :: currOutflow
00303     INTEGER :: i=0
00304     LOGICAL :: lMatch
00305     IDlist=0
00306     currOutflow=>firstoutflow
00307     DO WHILE(ASSOCIATED(currOutflow))
00308        CALL queryOutflow(currOutflow,lmatch,queryChar,lquery=lquery)
00309        IF(lmatch) THEN
00310           i=i+1
00311           IDlist(i)=curroutflow%id
00312        END IF
00313        currOutflow=>currOutflow%next
00314     END DO
00315   END SUBROUTINE queryLogical
00316 
00321   SUBROUTINE queryCh(queryChar,IDlist,cquery)
00322     ! Interface declarations
00323     CHARACTER(LEN=*) :: queryChar
00324     INTEGER,DIMENSION(:) :: IDlist
00325     CHARACTER(LEN=*),DIMENSION(:) :: cquery
00326     ! Internal declarations
00327     TYPE(OutflowDef),POINTER :: currOutflow
00328     INTEGER :: i=0
00329     LOGICAL :: lMatch
00330     IDlist=0
00331     currOutflow=>firstoutflow
00332     DO WHILE(ASSOCIATED(currOutflow))
00333        CALL queryOutflow(currOutflow,lmatch,queryChar,cquery=cquery)
00334        IF(lmatch) THEN
00335           i=i+1
00336           IDlist(i)=curroutflow%id
00337        END IF
00338        currOutflow=>currOutflow%next
00339     END DO
00340   END SUBROUTINE queryCh
00341     
00355   SUBROUTINE queryOutflow(outflow,lmatch,queryChar,dquery,fquery,iquery,lquery,cquery)
00356     ! Interface declarations
00357     TYPE(OutflowDef),POINTER :: outflow
00358     LOGICAL :: lmatch
00359     CHARACTER(LEN=*) :: queryChar
00360     REAL(KIND=qPrec),DIMENSION(:),OPTIONAL :: dquery
00361     REAL,DIMENSION(:),OPTIONAL :: fquery
00362     INTEGER,DIMENSION(:),OPTIONAL :: iquery
00363     LOGICAL,DIMENSION(:),OPTIONAL :: lquery
00364     CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: cquery
00365     ! Internal declarations
00366 
00367     queryChar=lowercase(queryChar)
00368 
00369     ! Doubles
00370     IF(PRESENT(dquery)) THEN
00371        SELECT CASE(queryChar)
00372        CASE('pos')
00373           IF(ALL(outflow%pos==dquery)) lmatch=.TRUE.
00374        CASE('radius')
00375           IF(ALL(outflow%radius==dquery)) lmatch=.TRUE.
00376        CASE('outflow_vector')
00377           IF(ALL(outflow%outflow_vector==dquery)) lmatch=.TRUE.
00378        CASE('opening_angle')
00379           IF(ALL(outflow%opening_angle==dquery)) lmatch=.TRUE.
00380        CASE('massflux')
00381           IF(ALL(outflow%massflux==dquery)) lmatch=.TRUE.
00382        CASE('momentumflux')
00383           IF(ALL(outflow%momentumflux==dquery)) lmatch=.TRUE.
00384        CASE('energyflux')
00385           IF(ALL(outflow%energyflux==dquery)) lmatch=.TRUE.
00386        CASE('precession_angle')
00387           IF(ALL(outflow%precession_angle==dquery)) lmatch=.TRUE.
00388        CASE('precession_rate')
00389           IF(ALL(outflow%precession_rate==dquery)) lmatch=.TRUE.
00390        CASE('tstart')
00391           IF(ALL(outflow%tstart==dquery)) lmatch=.TRUE.
00392        CASE('tend')
00393           IF(ALL(outflow%tend==dquery)) lmatch=.TRUE.
00394        CASE('startinterval')
00395           IF(ALL(outflow%startinterval==dquery)) lmatch=.TRUE.
00396        CASE('endinterval')
00397           IF(ALL(outflow%endinterval==dquery)) lmatch=.TRUE.
00398        CASE DEFAULT
00399           PRINT*,'outflow_source.f90::QueryOutflow error -- unknown dquery specified. Halting.'
00400           STOP
00401        END SELECT
00402     ! Floats
00403     ELSE IF(PRESENT(fquery)) THEN
00404        SELECT CASE(queryChar)
00405        CASE DEFAULT
00406           PRINT*,'outflow_source.f90::QueryOutflow error -- unknown fquery specified. Halting.'
00407           STOP 
00408       END SELECT
00409     ! Integers
00410     ELSE IF(PRESENT(iquery)) THEN
00411        SELECT CASE(queryChar)
00412        CASE('starttype')
00413           IF(ALL(outflow%starttype==iquery)) lmatch=.TRUE.
00414        CASE('endtype')
00415           IF(ALL(outflow%endtype==iquery)) lmatch=.TRUE.
00416        CASE('id')
00417           IF(ALL(outflow%id==iquery)) lmatch=.TRUE.
00418        CASE DEFAULT
00419           PRINT*,'outflow_source.f90::QueryOutflow error -- unknown iquery specified. Halting.'
00420           STOP
00421        END SELECT
00422     ! Logicals
00423     ELSE IF(PRESENT(lquery)) THEN
00424        SELECT CASE(queryChar)
00425        CASE('lbipolar')
00426           IF(ALL(outflow%lbipolar==lquery)) lmatch=.TRUE.
00427        CASE DEFAULT
00428           PRINT*,'outflow_source.f90::QueryOutflow error -- unknown lquery specified. Halting.'
00429           STOP
00430        END SELECT
00431     ! Characters
00432     ELSE IF(PRESENT(cquery)) THEN
00433        SELECT CASE(queryChar)
00434        CASE DEFAULT
00435           PRINT*,'outflow_source.f90::QueryOutflow error -- unknown cquery specified. Halting.'
00436           STOP
00437        END SELECT
00438     ELSE
00439        PRINT*,'outflow_source.f90::QueryOutflow error -- subroutine called missing argument. Halting.'
00440        STOP
00441     END IF
00442 
00443   CONTAINS
00444     FUNCTION lowercase(string)
00445       CHARACTER(LEN=*) :: string
00446       CHARACTER(LEN=26) :: UPPER='ABCDEFGHIJKLMNOPQRSTUVWXYZ' 
00447                          , lower='abcdefghijklmnopqrstuvwxyz'
00448       CHARACTER(LEN=LEN(string)) :: lowercase
00449       INTEGER :: i,ind,ind2
00450 
00451       ! convert to lowercase
00452       ind=0;ind2=0
00453       DO i=1,LEN(string)
00454          ind=SCAN(string,UPPER)
00455          IF(ind>0) THEN 
00456             ind2=INDEX(UPPER,string(ind:ind))
00457             string(ind:ind)=lower(ind2:ind2)
00458             ind=0;ind2=0
00459          END IF
00460       END DO
00461       lowercase=string
00462     END FUNCTION lowercase
00463   END SUBROUTINE queryOutflow
00464 END MODULE OutflowSrc
 All Classes Files Functions Variables