Scrambler  1
pdfs.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 !    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
 All Classes Files Functions Variables