Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! object_declarations.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 ObjectDeclarations 00024 IMPLICIT NONE 00025 00026 INTEGER, PARAMETER :: AMBIENTOBJ = 0, DISKOBJ = 1, CLUMPOBJ = 2, COLLIDINGFLOWOBJ = 3, 00027 REFINEMENTOBJ = 4, SHAPEOBJ = 5, SPLITREGIONOBJ = 6, 00028 UNIFORMREGIONOBJ = 7, PERTURBOBJ = 8, VECTORPERTURBOBJ = 9, 00029 OUTFLOWOBJ = 10, WINDOBJ = 11 00030 00031 TYPE ObjectDef 00032 INTEGER :: type, id 00033 CHARACTER(len=1), DIMENSION(:), ALLOCATABLE :: storage 00034 TYPE (ObjectDef), POINTER :: prev => null() 00035 TYPE (ObjectDef), POINTER :: next => null() 00036 END TYPE ObjectDef 00037 00038 TYPE (ObjectDef), POINTER :: ListHead => null() 00039 TYPE (ObjectDef), POINTER :: ListTail => null() 00040 00041 INTEGER :: len 00042 CHARACTER(LEN=1) :: dummy_char(10) 00043 00044 SAVE 00045 00046 CONTAINS 00047 00048 FUNCTION ObjectListAdd(Object, type) 00049 TYPE(ObjectDef), POINTER :: Object 00050 INTEGER :: type, ObjectListAdd 00051 ALLOCATE(Object) 00052 Object%type = type 00053 !write(*,*) "ADDING OBJ", Object%type 00054 IF (.NOT.ASSOCIATED(ListHead)) THEN 00055 ListHead => Object 00056 ListTail => Object 00057 ObjectListAdd = 0 00058 ELSE 00059 ListTail%next => Object 00060 Object%prev => ListTail 00061 ListTail => Object 00062 Object%id = Object%prev%id + 1 00063 ObjectListAdd = Object%id 00064 END IF 00065 END FUNCTION ObjectListAdd 00066 00067 SUBROUTINE ObjectListRemove(id) 00068 TYPE(ObjectDef), POINTER :: Object 00069 INTEGER :: id 00070 !write(*,*) "removing... ", id 00071 Object => ListHead 00072 DO WHILE(ASSOCIATED(Object)) 00073 IF (Object%id == id) THEN 00074 IF(ASSOCIATED(Object%prev)) THEN 00075 Object%prev%next => Object%next 00076 ELSE 00077 ListHead => Object%next 00078 END IF 00079 00080 IF(ASSOCIATED(Object%next)) THEN 00081 Object%next%prev => Object%prev 00082 ELSE 00083 ListTail => null() 00084 END IF 00085 DEALLOCATE(Object%storage) 00086 DEALLOCATE(Object) 00087 EXIT 00088 END IF 00089 Object => Object%next 00090 END DO 00091 END SUBROUTINE ObjectListRemove 00092 00093 FUNCTION ObjectListFind(id) 00094 TYPE(ObjectDef), POINTER :: ObjectListFind, Object 00095 INTEGER :: id 00096 Object => ListHead 00097 DO WHILE(ASSOCIATED(Object)) 00098 IF (Object%id == id) THEN 00099 ObjectListFind => Object 00100 RETURN 00101 END IF 00102 Object => Object%next 00103 END DO 00104 ObjectListFind => null() 00105 END FUNCTION ObjectListFind 00106 00107 END MODULE ObjectDeclarations