Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! totals.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 Totals 00024 USE TreeDeclarations 00025 USE DataDeclarations 00026 USE PhysicsDeclarations 00027 USE GlobalDeclarations 00028 USE EllipticDeclarations 00029 USE ParticleDeclarations 00030 USE Fields 00031 USE Shapes 00032 IMPLICIT NONE 00033 TYPE TotalDef 00034 TYPE(FieldDef) :: Field 00035 REAL(KIND=qPREC) :: CurrentValue=0d0 00036 TYPE(ShapeDef), POINTER :: shape=>NULL() 00037 TYPE(TotalDef), POINTER :: next=>NULL() 00038 END TYPE TotalDef 00039 00040 TYPE(TotalDef), POINTER :: FirstTotal, LastTotal 00041 LOGICAL :: lFirstTotalFrame 00042 SAVE 00043 CONTAINS 00044 SUBROUTINE TotalInit() 00045 Nullify(FirstTotal, LastTotal) 00046 lFirstTotalFrame=.true. 00047 END SUBROUTINE TotalInit 00048 00049 00050 SUBROUTINE AddAllTotals(component, OptShape) 00051 INTEGER :: component, j 00052 TYPE(TotalDef), POINTER :: Total 00053 TYPE(ShapeDef), POINTER, OPTIONAL :: OptShape 00054 IF (Component /= GASCOMP .AND. Component /= PARTICLECOMP .AND. Component /= BOTHCOMP) THEN 00055 IF (MPI_ID == 0) PRINT*, 'Err - unrecognized component in AddAllTotals' 00056 ELSE 00057 DO j=1,NrFieldVars 00058 CALL CreateTotal(Total) 00059 Total%Field%Component=component 00060 Total%Field%id=j 00061 Total%Field%name=FieldName(j) 00062 IF (Present(OptShape)) Total%shape=>OptShape 00063 END DO 00064 DO j=1,NrTracerVars 00065 CALL CreateTotal(Total) 00066 Total%Field%Component=COMPONENT 00067 Total%Field%id=NrFieldVars+j 00068 Total%Field%name=TracerName(j) 00069 IF (Present(OptShape)) Total%shape=>OptShape 00070 END DO 00071 CALL CreateTotal(Total) 00072 Total%Field%Component=Component 00073 Total%Field%id=KE_Field 00074 Total%Field%name='Kinetic_Energy' 00075 IF (Present(OptShape)) Total%shape=>OptShape 00076 CALL CreateTotal(Total) 00077 Total%Field%Component=Component 00078 Total%Field%id=iE_Field 00079 Total%Field%name='Internal_Energy' 00080 IF (Present(OptShape)) Total%shape=>OptShape 00081 CALL CreateTotal(Total) 00082 Total%Field%Component=Component 00083 Total%Field%id=P_Field 00084 Total%Field%name='Pressure' 00085 IF (Present(OptShape)) Total%shape=>OptShape 00086 CALL CreateTotal(Total) 00087 Total%Field%Component=Component 00088 Total%Field%id=Temp_Field 00089 Total%Field%name='Temperature' 00090 IF (Present(OptShape)) Total%shape=>OptShape 00091 IF (lMHD) THEN 00092 CALL CreateTotal(Total) 00093 Total%Field%Component=Component 00094 Total%Field%id=BE_Field 00095 Total%Field%name='Magnetic_Energy' 00096 IF (Present(OptShape)) Total%shape=>OptShape 00097 END IF 00098 IF (lSelfGravity) THEN 00099 CALL CreateTotal(Total) 00100 Total%Field%Component=Component 00101 Total%Field%id=GravEnergy_Field 00102 Total%Field%name='Gravitational_Energy' 00103 IF (Present(OptShape)) Total%shape=>OptShape 00104 END IF 00105 END IF 00106 END SUBROUTINE AddAllTotals 00107 00108 SUBROUTINE CreateTotal(Total) 00109 TYPE(TotalDef), POINTER :: Total 00110 ALLOCATE(Total) 00111 CALL AddTotalToList(Total) 00112 END SUBROUTINE CreateTotal 00113 00114 SUBROUTINE DestroyTotal(Total) 00115 TYPE(TotalDef), POINTER :: Total 00116 DEALLOCATE(Total) 00117 NULLIFY(Total) 00118 END SUBROUTINE DestroyTotal 00119 00120 SUBROUTINE AddTotalToList(Total) 00121 TYPE(TotalDef),POINTER :: Total 00122 IF(.NOT. ASSOCIATED(FirstTotal)) THEN ! First Total Object only 00123 FirstTotal=>Total 00124 LastTotal=>Total 00125 ELSE 00126 LastTotal%next=>Total 00127 LastTotal=>Total 00128 END IF 00129 END SUBROUTINE AddTotalToList 00130 00131 SUBROUTINE ProcessTotals 00132 TYPE(TotalDef), POINTER :: Total 00133 Total=>FirstTotal 00134 DO WHILE (ASSOCIATED(Total)) 00135 CALL ProcessTotal(Total) 00136 Total=>Total%next 00137 END DO 00138 CALL OutputTotals 00139 00140 END SUBROUTINE ProcessTotals 00141 00142 SUBROUTINE ProcessTotal(Total) 00143 TYPE(TotalDef), POINTER :: Total 00144 INTEGER :: n 00145 TYPE(NodeDefList), POINTER :: NodeList 00146 TYPE(ParticleListDef), POINTER :: ParticleList 00147 REAL(KIND=qPREC) :: rpos(3) 00148 Total%CurrentValue=0d0 00149 IF (Total%Field%Component==GASCOMP .OR. Total%Field%Component==BOTHCOMP) THEN 00150 DO n=0, MaxLevel 00151 Nodelist=>Nodes(n)%p 00152 DO WHILE (ASSOCIATED(NodeList)) 00153 CALL ProcessTotalInfo(Nodelist%self%info, Total) 00154 Nodelist=>Nodelist%next 00155 END DO 00156 END DO 00157 CALL CollectTotal(Total) 00158 END IF 00159 IF (Total%Field%Component==PARTICLECOMP .OR. Total%Field%Component==BOTHCOMP) THEN 00160 ParticleList=>SinkParticles 00161 DO WHILE (ASSOCIATED(ParticleList)) 00162 IF (ASSOCIATED(Total%shape)) THEN 00163 IF (IsInShape(Total%shape, ParticleList%self%xloc, rpos, levels(0)%tnow)) THEN 00164 Total%CurrentValue=Total%CurrentValue+GetParticleField(ParticleList%self, Total%Field%id) 00165 END IF 00166 ELSE 00167 Total%CurrentValue=Total%CurrentValue+GetParticleField(ParticleList%self, Total%Field%id) 00168 END IF 00169 ParticleList=>ParticleList%next 00170 END DO 00171 END IF 00172 END SUBROUTINE ProcessTotal 00173 00174 SUBROUTINE ProcessTotalInfo(Info, Total) 00175 TYPE(InfoDef) :: Info 00176 TYPE(TotalDef) :: Total 00177 INTEGER :: i,j,k 00178 REAL(KIND=qPREC) :: dv, pos(3), rpos(3) 00179 dv=levels(Info%level)%dx**nDim 00180 DO i=1, Info%mX(1) 00181 IF (iCylindrical /= NoCyl) dv=levels(Info%level)%dx**nDim*(Info%xBounds(1,1)+levels(Info%level)%dx*(REAL(i)-.5d0)) 00182 DO j=1, Info%mX(2) 00183 DO k=1, Info%mX(3) 00184 IF (ASSOCIATED(Total%shape)) THEN 00185 pos=CellPos(Info, i, j, k) 00186 IF (.NOT. IsInShape(Total%shape, pos, rpos, levels(Info%level)%tnow)) CYCLE 00187 END IF 00188 IF (Info%level < MaxLevel) THEN 00189 IF (Info%ChildMask(i,j,k) /= 0) THEN 00190 ! PRINT*, 'cycling' 00191 CYCLE 00192 END IF 00193 END IF 00194 Total%CurrentValue=Total%CurrentValue+GetField(Info,i,j,k,Total%Field%ID)*dv 00195 END DO 00196 END DO 00197 END DO 00198 END SUBROUTINE ProcessTotalInfo 00199 00200 00201 00202 SUBROUTINE CollectTotal(Total) 00203 TYPE(TotalDef), POINTER :: Total 00204 INTEGER :: iErr 00205 CALL MPI_ALLREDUCE(MPI_IN_PLACE, Total%CurrentValue, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) 00206 END SUBROUTINE CollectTotal 00207 00208 00209 SUBROUTINE OutputTotals 00210 TYPE(TotalDef), POINTER :: Total 00211 INTEGER :: iErr 00212 IF (MPI_ID == 0) THEN 00213 OPEN(UNIT=TOTALS_DATA_HANDLE, FILE=TOTALS_DATA_FILE, STATUS='OLD', POSITION='APPEND', IOSTAT=iErr) 00214 IF (iErr /= 0) THEN !File does not already exist 00215 OPEN(UNIT=TOTALS_DATA_HANDLE, FILE=TOTALS_DATA_FILE, STATUS='NEW', IOSTAT=iErr) 00216 IF (iErr /= 0) THEN !File cannot be created new either 00217 PRINT*, 'Error - cannot open file as old or new' 00218 STOP 00219 END IF 00220 END IF 00221 IF (lFirstTotalFrame) THEN 00222 write(TOTALS_DATA_HANDLE,'(A20)', ADVANCE='NO') 'Time ' 00223 Total=>FirstTotal 00224 DO WHILE (ASSOCIATED(Total)) 00225 IF (ASSOCIATED(total%next)) THEN 00226 write(TOTALS_DATA_HANDLE,'(A20)', ADVANCE='NO') GetName(Total%field) 00227 ELSE 00228 write(TOTALS_DATA_HANDLE,'(A20)') GetName(Total%field) 00229 END IF 00230 Total=>Total%next 00231 END DO 00232 lFirstTotalFrame=.false. 00233 END IF 00234 write(TOTALS_DATA_HANDLE,'(E20.11)', ADVANCE='NO') levels(0)%tnow 00235 Total=>FirstTotal 00236 DO WHILE (ASSOCIATED(Total)) 00237 IF (ASSOCIATED(total%next)) THEN 00238 write(TOTALS_DATA_HANDLE,'(E20.11)', ADVANCE='NO') Total%CurrentValue 00239 ELSE 00240 write(TOTALS_DATA_HANDLE,'(E20.11)') Total%CurrentValue 00241 END IF 00242 Total=>Total%next 00243 END DO 00244 CLOSE(TOTALS_DATA_HANDLE) 00245 END IF 00246 END SUBROUTINE OutputTotals 00247 END MODULE Totals