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