Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! pdfs.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 PDFs 00024 USE TreeDeclarations 00025 USE DataDeclarations 00026 USE PhysicsDeclarations 00027 USE GlobalDeclarations 00028 USE EllipticDeclarations 00029 USE EOS 00030 USE ParticleDeclarations 00031 USE Shapes 00032 USE Fields 00033 USE IOBOV 00034 USE ProcessingDeclarations 00035 IMPLICIT NONE 00036 TYPE PDFDef 00037 TYPE(FieldDef) :: Field(2) 00038 REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: Data 00039 INTEGER :: Scale(2)=LINEARSCALE 00040 REAL(KIND=qPREC) :: minvalue(2)=MINOVERALL 00041 REAL(KIND=qPREC) :: maxvalue(2)=MAXOVERALL 00042 INTEGER :: nBins(2)=100 00043 INTEGER :: WeightField=VOLUME 00044 TYPE(ShapeDef), POINTER :: Shape 00045 TYPE(PDFDef), POINTER :: next 00046 END TYPE PDFDef 00047 00048 00049 TYPE(PDFDef), POINTER :: FirstPDF, LastPDF 00050 00051 CONTAINS 00052 SUBROUTINE PDFInit() 00053 Nullify(FirstPDF, LastPDF) 00054 END SUBROUTINE PDFInit 00055 00056 SUBROUTINE CreatePDF(PDF) 00057 TYPE(PDFDef), POINTER :: PDF 00058 ALLOCATE(PDF) 00059 CALL AddPDFToList(PDF) 00060 NULLIFY(PDF%next) 00061 NULLIFY(PDF%shape) 00062 END SUBROUTINE CreatePDF 00063 00064 SUBROUTINE DestroyPDF(PDF) 00065 TYPE(PDFDef), POINTER :: PDF 00066 DEALLOCATE(PDF) 00067 NULLIFY(PDF) 00068 END SUBROUTINE DestroyPDF 00069 00070 SUBROUTINE AddPDFToList(PDF) 00071 TYPE(PDFDef),POINTER :: PDF 00072 IF(.NOT. ASSOCIATED(FirstPDF)) THEN ! First PDF Object only 00073 FirstPDF=>PDF 00074 LastPDF=>PDF 00075 ELSE 00076 LastPDF%next=>PDF 00077 LastPDF=>PDF 00078 END IF 00079 END SUBROUTINE AddPDFToList 00080 00081 SUBROUTINE ProcessPDFs 00082 TYPE(PDFDef), POINTER :: PDF 00083 INTEGER :: n,l 00084 TYPE(NodeDefList), POINTER :: NodeList 00085 TYPE(ParticleListDef), POINTER :: ParticleList 00086 REAL(KIND=qPREC) :: minvalue(2), maxvalue(2), dx(2), weight, data(2),rpos(3) 00087 CHARACTER(LEN=25) :: FileName 00088 00089 PDF=>FirstPDF 00090 DO WHILE (ASSOCIATED(PDF)) 00091 IF (PDF%Field(1)%Component /= PDF%Field(2)%Component) THEN 00092 IF (MPI_ID == 0) PRINT*, 'Error pdf fields must have same component' 00093 ELSE 00094 00095 ALLOCATE(PDF%Data(PDF%nBins(1), PDF%nBins(2))) 00096 PDF%Data=0d0 00097 DO l=1,2 00098 IF (PDF%minvalue(l)==MINOVERALL) THEN 00099 IF (ASSOCIATED(PDF%shape)) THEN 00100 minvalue(l)=FindMin(PDF%Field(l), PDF%Shape) 00101 ELSE 00102 minvalue(l)=FindMin(PDF%Field(l)) 00103 END IF 00104 ELSE 00105 minvalue(l)=PDF%minvalue(l) 00106 END IF 00107 IF (PDF%maxvalue(l)==MAXOVERALL) THEN 00108 IF (ASSOCIATED(PDF%shape)) THEN 00109 maxvalue(l)=FindMax(PDF%Field(l), PDF%Shape) 00110 ELSE 00111 maxvalue(l)=FindMax(PDF%Field(l)) 00112 END IF 00113 ELSE 00114 maxvalue(l)=PDF%maxvalue(l) 00115 END IF 00116 IF (PDF%Scale(l)==LOGSCALE) THEN 00117 minvalue(l)=log10(minvalue(l)) 00118 maxvalue(l)=log10(maxvalue(l)) 00119 END IF 00120 END DO 00121 dx=(maxvalue-minvalue)/REAL(PDF%nbins) 00122 IF (PDF%Field(1)%Component==GASCOMP .OR. PDF%Field(1)%Component==BOTHCOMP) THEN 00123 DO n=0, MaxLevel 00124 Nodelist=>Nodes(n)%p 00125 DO WHILE (ASSOCIATED(NodeList)) 00126 CALL ProcessPDF(Nodelist%self%info, PDF, minvalue, maxvalue, dx) 00127 Nodelist=>Nodelist%next 00128 END DO 00129 END DO 00130 END IF 00131 IF (PDF%Field(1)%Component==PARTICLECOMP .OR. PDF%Field(1)%Component==BOTHCOMP) THEN 00132 ParticleList=>SinkParticles 00133 DO WHILE (ASSOCIATED(ParticleList)) 00134 IF (ASSOCIATED(PDF%shape)) THEN 00135 IF (.NOT. IsInShape(PDF%shape, ParticleList%self%xloc, rpos, levels(0)%tnow)) THEN 00136 ParticleList=>ParticleList%next 00137 CYCLE 00138 END IF 00139 END IF 00140 00141 IF (PDF%WeightField == VOLUME) THEN 00142 weight=1d0 00143 ELSEIF (PDF%WeightField == MASS) THEN 00144 weight=ParticleList%self%q(1) 00145 ELSE 00146 weight=GetParticleField(ParticleList%self, PDF%WeightField) 00147 END IF 00148 DO l=1,2 00149 data(l)=GetParticleField(ParticleList%self, PDF%Field(l)%ID) 00150 IF (PDF%Scale(l)==LOGSCALE) data(l)=log10(data(l)) 00151 END DO 00152 CALL BinData2D(data,weight,PDF%Data,minvalue,maxvalue,dx) 00153 ParticleList=>ParticleList%next 00154 END DO 00155 END IF 00156 CALL CollectPDF(PDF) 00157 CALL OutputPDF(PDF, minvalue, maxvalue, dx) 00158 DEALLOCATE(PDF%Data) 00159 END IF 00160 PDF=>PDF%next 00161 END DO 00162 END SUBROUTINE ProcessPDFs 00163 00164 SUBROUTINE ProcessPDF(Info, PDF, minvalue, maxvalue, dx) 00165 TYPE(InfoDef) :: Info 00166 TYPE(PDFDef) :: PDF 00167 INTEGER :: i,j,k,l 00168 REAL(KIND=qPREC) :: dv, minvalue(2), maxvalue(2), dx(2), weight, data(2), pos(3), rpos(3) 00169 dv=levels(Info%level)%dx**nDim 00170 DO i=1, Info%mX(1) 00171 IF (iCylindrical /= NoCyl) dv=levels(Info%level)%dx**nDim*(Info%xBounds(1,1)+levels(Info%level)%dx*(REAL(i)-.5d0)) 00172 DO j=1, Info%mX(2) 00173 DO k=1, Info%mX(3) 00174 IF (Info%level < MaxLevel) THEN 00175 IF (Info%ChildMask(i,j,k) /= 0) THEN 00176 ! PRINT*, 'cycling' 00177 CYCLE 00178 END IF 00179 END IF 00180 pos=CellPos(Info, i, j, k) 00181 IF (ASSOCIATED(PDF%shape)) THEN 00182 IF (.NOT. IsInShape(PDF%shape, pos, rpos, levels(Info%level)%tnow)) CYCLE 00183 END IF 00184 00185 IF (PDF%WeightField == VOLUME) THEN 00186 weight=dv 00187 ELSEIF (PDF%WeightField == MASS) THEN 00188 weight=dv*Info%q(i,j,k,1) 00189 ELSE 00190 weight=dv*GetField(Info,i,j,k, PDF%WeightField) 00191 END IF 00192 DO l=1,2 00193 data(l)=GetField(Info,i,j,k, PDF%Field(l)%ID) 00194 IF (PDF%Scale(l)==LOGSCALE) data(l)=log10(data(l)) 00195 END DO 00196 CALL BinData2D(data,weight,PDF%Data,minvalue,maxvalue,dx) 00197 END DO 00198 END DO 00199 END DO 00200 END SUBROUTINE ProcessPDF 00201 00202 SUBROUTINE BinData2D(data, weight, bins, minvalue, maxvalue, dx) 00203 REAL(KIND=qPREC) :: data(2), weight, minvalue(2), maxvalue(2), dx(2) 00204 REAL(KIND=qPrec), DIMENSION(:,:) :: bins 00205 INTEGER :: iloc(2),l 00206 IF (isNAN(data(1)) .OR. isNan(data(2))) RETURN 00207 DO l=1,2 00208 iloc(l)=max(1,min(size(bins,l), ceiling((data(l)-minvalue(l))/dx(l)))) 00209 END DO 00210 bins(iloc(1),iloc(2))=bins(iloc(1),iloc(2))+weight 00211 END SUBROUTINE BinData2D 00212 00213 00214 SUBROUTINE CollectPDF(PDF) 00215 TYPE(PDFDef), POINTER :: PDF 00216 INTEGER :: iErr 00217 REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: totals 00218 IF (MPI_NP == 1) RETURN 00219 CALL MPI_ALLREDUCE(MPI_IN_PLACE, PDF%Data, product(PDF%nbins), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) 00220 END SUBROUTINE CollectPDF 00221 00222 00223 SUBROUTINE OutputPDF(PDF, minvalue, maxvalue, dx) 00224 TYPE(PDFDef), POINTER :: PDF 00225 INTEGER :: i 00226 CHARACTER(LEN=9), PARAMETER :: DATAFORMAT = '(2E25.16)' 00227 REAL(KIND=qPREC) :: minvalue(2), maxvalue(2), dx(2) 00228 CHARACTER(LEN=80) :: Name 00229 IF (MPI_ID == 0) THEN 00230 WRITE(Name, '(A,A10,A,A4,A,A1,I5.5)') TRIM(WeightName(PDF%weightfield)), '_weighted_',TRIM(GetName(PDF%Field(1))), '_vs_', TRIM(GetName(PDF%Field(2))),'_',current_frame 00231 CALL WriteBOV2DScalar(name, minvalue, maxvalue, levels(0)%tnow, PDF%data, 'pdf') 00232 END IF 00233 END SUBROUTINE OutputPDF 00234 00235 00236 FUNCTION WeightName(FieldID) 00237 CHARACTER(LEN=MAXFIELDSLENGTH) :: WeightName 00238 INTEGER :: FieldID 00239 IF (FieldID == VOLUME) THEN 00240 WeightName='volume' 00241 ELSEIF (FieldID == MASS) THEN 00242 WeightName='mass' 00243 ELSE 00244 WeightName=GetName(FieldID) 00245 END IF 00246 END FUNCTION WeightName 00247 00248 00249 END MODULE PDFs