Scrambler  1
object_control.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 !    objects.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 ObjectControl
00024   USE Ambients
00025   USE Clumps
00026   USE CollidingFlows
00027   USE Disks
00028   USE Outflows
00029   USE Refinements
00030   USE Splitregions
00031   USE Uniformregions
00032   USE Winds
00033   USE ObjectDeclarations
00034 
00035   IMPLICIT NONE
00036 
00037 CONTAINS
00038 
00039 
00040   SUBROUTINE ObjectsGridInit(Info,type)
00041     TYPE(ObjectDef), POINTER :: Object
00042     TYPE (InfoDef) :: Info  
00043     INTEGER, OPTIONAL :: type
00044     Object => ListHead
00045     !write(*,*) "traversing...."
00046     DO WHILE(ASSOCIATED(Object))
00047        IF (PRESENT(TYPE)) THEN
00048           IF (Object%type == TYPE) CALL ObjectGridInit(Info, Object)
00049        ELSE
00050           CALL ObjectGridInit(Info, Object)
00051        END IF
00052        Object => Object%next
00053     END DO
00054   END SUBROUTINE ObjectsGridInit
00055 
00056   SUBROUTINE ObjectGridInit(Info,Object)
00057     TYPE(ObjectDef), POINTER :: Object
00058     TYPE (InfoDef) :: Info 
00059 
00060     SELECT CASE (Object%type)
00061     CASE (AMBIENTOBJ)
00062        pAmbient = transfer(Object%storage,pAmbient)
00063        CALL AmbientGridInit(Info, pAmbient%ptr)
00064     CASE (CLUMPOBJ)
00065        pClump = transfer(Object%storage,pClump)
00066        CALL ClumpGridInit(Info,pClump%ptr)
00067     CASE (COLLIDINGFLOWOBJ)
00068        pCollidingFlow = transfer(Object%storage,pCollidingFlow)
00069        CALL CollidingFlowGridInit(Info, pCollidingFlow%ptr)
00070     CASE (DISKOBJ)
00071        pDisk = transfer(Object%storage,pDisk)
00072        CALL DiskGridInit(Info, pDisk%ptr)
00073     CASE (SPLITREGIONOBJ)
00074        pSplitRegion = transfer(Object%storage,pSplitRegion)
00075        CALL SplitRegionGridInit(Info, pSplitRegion%ptr)
00076     CASE (UNIFORMREGIONOBJ)
00077        pUniformRegion = transfer(Object%storage,pUniformRegion)
00078        CALL UniformRegionGridInit(Info, pUniformRegion%ptr)
00079     CASE (OUTFLOWOBJ)
00080        pOutflow = transfer(Object%storage,pOutflow)
00081        CALL OutflowGridInit(Info, pOutflow%ptr)
00082     CASE (WINDOBJ)
00083        pWind = transfer(Object%storage,pWind)
00084        CALL WindGridInit(Info,pWind%ptr)
00085     END SELECT
00086 
00087   END SUBROUTINE ObjectGridInit
00088 
00089   SUBROUTINE ObjectsSetErrFlag(Info, type)
00090     TYPE (InfoDef) :: Info
00091     TYPE(ObjectDef), POINTER :: Object
00092     INTEGER, OPTIONAL :: type
00093     Object => ListHead
00094     DO WHILE(ASSOCIATED(Object))
00095        IF (PRESENT(type)) THEN
00096           IF (Object%type == TYPE) CALL ObjectSetErrFlag(Info, Object)
00097        ELSE
00098           CALL ObjectSetErrFlag(Info, Object)
00099        ENDIF
00100        Object => Object%next
00101     END DO
00102   END SUBROUTINE ObjectsSetErrFlag
00103 
00104 
00105   SUBROUTINE ObjectSetErrFlag(Info, Object)
00106     TYPE(ObjectDef), POINTER :: Object
00107     TYPE (InfoDef) :: Info  
00108 
00109     SELECT CASE (Object%type)
00110     CASE (AMBIENTOBJ)
00111        pAmbient = transfer(Object%storage,pAmbient)
00112        CALL AmbientSetErrFlag(Info, pAmbient%ptr)
00113     CASE (CLUMPOBJ)
00114        pClump = transfer(Object%storage,pClump)
00115        CALL ClumpSetErrFlag(Info,pClump%ptr)
00116     CASE (COLLIDINGFLOWOBJ)
00117        pCollidingFlow = transfer(Object%storage,pCollidingFlow)
00118        CALL CollidingFlowSetErrFlag(Info, pCollidingFlow%ptr)
00119     CASE (DISKOBJ)
00120        pDisk = transfer(Object%storage,pDisk)
00121        CALL DiskSetErrFlag(Info, pDisk%ptr)
00122     CASE (SPLITREGIONOBJ)
00123        pSplitRegion = transfer(Object%storage,pSplitRegion)
00124        CALL SplitRegionSetErrFlag(Info, pSplitRegion%ptr)
00125     CASE (UNIFORMREGIONOBJ)
00126        pUniformRegion = transfer(Object%storage,pUniformRegion)
00127        CALL UniformRegionSetErrFlag(Info, pUniformRegion%ptr)
00128     CASE (OUTFLOWOBJ)
00129        pOutflow = transfer(Object%storage,pOutflow)
00130        CALL OutflowSetErrFlag(Info, pOutflow%ptr)
00131     CASE (WINDOBJ)
00132        pWind = transfer(Object%storage,pWind)
00133        CALL WindSetErrFlag(Info,pWind%ptr)
00134     CASE (REFINEMENTOBJ)
00135        pRefinement = transfer(Object%storage,pRefinement)
00136        CALL RefinementSetErrFlag(Info,pRefinement%ptr)       
00137     END SELECT
00138 
00139   END SUBROUTINE ObjectSetErrFlag
00140 
00141 
00142   SUBROUTINE ObjectsBeforeStep(Info,type)
00143     TYPE(ObjectDef), POINTER :: Object
00144     TYPE (InfoDef) :: Info  
00145     INTEGER, OPTIONAL ::  type
00146     Object => ListHead
00147     !write(*,*) "traversing...."
00148     DO WHILE(ASSOCIATED(Object))
00149        IF (PRESENT(type)) THEN
00150           IF (Object%type == TYPE) CALL ObjectBeforeStep(Info, Object)
00151        ELSE
00152           CALL ObjectBeforeStep(Info, Object)
00153        END IF
00154        Object => Object%next
00155     END DO
00156   END SUBROUTINE ObjectsBeforeStep
00157 
00158 
00159   SUBROUTINE ObjectBeforeStep(Info, Object)
00160     TYPE(ObjectDef), POINTER :: Object
00161     TYPE (InfoDef) :: Info  
00162     SELECT CASE (Object%type)
00163     CASE (AMBIENTOBJ)
00164        pAmbient = transfer(Object%storage,pAmbient)
00165        CALL AmbientBeforeStep(Info, pAmbient%ptr)
00166     CASE (CLUMPOBJ)
00167        pClump = transfer(Object%storage,pClump)
00168        CALL ClumpBeforeStep(Info, pClump%ptr)
00169     CASE (COLLIDINGFLOWOBJ)
00170        pCollidingFlow = transfer(Object%storage,pCollidingFlow)
00171        CALL CollidingFlowBeforeStep(Info, pCollidingFlow%ptr)
00172     CASE (DISKOBJ)
00173        pDisk = transfer(Object%storage,pDisk)
00174        CALL DiskBeforeStep(Info, pDisk%ptr)
00175     CASE (SPLITREGIONOBJ)
00176        pSplitRegion = transfer(Object%storage,pSplitRegion)
00177        CALL SplitRegionBeforeStep(Info, pSplitRegion%ptr)
00178     CASE (UNIFORMREGIONOBJ)
00179        pUniformRegion = transfer(Object%storage,pUniformRegion)
00180        CALL UniformRegionBeforeStep(Info, pUniformRegion%ptr)
00181     CASE (OUTFLOWOBJ)
00182        pOutflow = transfer(Object%storage,pOutflow)
00183        CALL OutflowBeforeStep(Info, pOutflow%ptr)
00184     CASE (WINDOBJ)
00185        pWind = transfer(Object%storage,pWind)
00186        CALL WindBeforeStep(Info, pWind%ptr)
00187     END SELECT
00188 
00189   END SUBROUTINE ObjectBeforeStep
00190 
00191 END MODULE ObjectControl
 All Classes Files Functions Variables