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