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