Scrambler  1
projections.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 !    projections.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 Projections
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 IOBOV
00033    USE ProcessingDeclarations
00034    USE Images
00035    USE Shapes
00036    USE Cameras
00037    USE Movies
00038    IMPLICIT NONE
00039    INTEGER, PARAMETER :: MAXIMUMPLOTLEVEL=-1
00040    TYPE ProjectionDef
00041       TYPE(FieldDef) :: Field
00042       REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: Data
00043       REAL(KIND=qPREC), DIMENSION(:,:), ALLOCATABLE :: ParticleData
00044       INTEGER :: dim=3
00045       REAL(KIND=qPREC) :: pow=1d0
00046       LOGICAL :: lReadCameraList=.false.
00047       INTEGER :: PlotLevel=MAXIMUMPLOTLEVEL
00048       TYPE(ShapeDef), POINTER :: Shape => NULL()
00049       TYPE(ProjectionDef), POINTER :: next      
00050       TYPE(CameraDef), POINTER :: Camera => NULL()
00051       TYPE(ImageDef), POINTER :: Image => NULL()
00052       TYPE(MovieDef), POINTER :: Movie => NULL()
00053    END TYPE ProjectionDef
00054    
00055    TYPE(ProjectionDef), POINTER :: FirstProjection, LastProjection
00056 
00057 CONTAINS
00058    SUBROUTINE ProjectionInit()
00059       Nullify(FirstProjection, LastProjection)
00060    END SUBROUTINE ProjectionInit
00061 
00062    SUBROUTINE CreateProjection(Projection)
00063       TYPE(ProjectionDef), POINTER :: Projection
00064       ALLOCATE(Projection)
00065       CALL AddProjectionToList(Projection)
00066       NULLIFY(Projection%next)
00067       NULLIFY(Projection%shape)
00068    END SUBROUTINE CreateProjection
00069 
00070    SUBROUTINE DestroyProjection(Projection)
00071       TYPE(ProjectionDef), POINTER :: Projection
00072       DEALLOCATE(Projection)
00073       NULLIFY(Projection)
00074    END SUBROUTINE DestroyProjection
00075 
00076    SUBROUTINE AddProjectionToList(Projection)
00077       TYPE(ProjectionDef),POINTER :: Projection
00078       IF(.NOT. ASSOCIATED(FirstProjection)) THEN ! First Projection Object only
00079          FirstProjection=>Projection
00080          LastProjection=>Projection
00081       ELSE
00082          LastProjection%next=>Projection
00083          LastProjection=>Projection
00084       END IF
00085    END SUBROUTINE AddProjectionToList
00086 
00087    SUBROUTINE ProcessProjections
00088       TYPE(ProjectionDef), POINTER :: Projection
00089       INTEGER :: n,l,mx(3), PlotLevel, axis(3),ipos(3), i, j
00090       TYPE(NodeDefList), POINTER :: NodeList
00091       TYPE(ParticleListDef), POINTER :: ParticleList
00092       REAL(KIND=qPREC) :: rpos(3)
00093 !      IF (nDim == 1) RETURN
00094       Projection=>FirstProjection
00095       DO WHILE (ASSOCIATED(Projection))        
00096          IF (Projection%PlotLevel == MAXIMUMPLOTLEVEL) THEN
00097             PlotLevel=FinestLevel
00098          ELSE
00099             PlotLevel=min(Projection%PlotLevel,MaxLevel)
00100          END IF
00101 
00102          IF (Projection%lReadCameraList) THEN
00103             OPEN(UNIT=CAMERA_DATA_HANDLE, FILE='camera.data', STATUS='old')
00104             READ(CAMERA_DATA_HANDLE, '(I10)') nCameras
00105             CALL CreateCamera(Projection%Camera)
00106             nCameras=nCameras-1
00107          ELSE
00108             nCameras=1
00109             IF (ASSOCIATED(Projection%Movie)) THEN
00110                IF (.NOT. ASSOCIATED(Projection%Camera)) CALL CreateCamera(Projection%Camera)
00111                CALL UpdateMovieCamera(Projection%Movie, Projection%Camera)
00112             END IF
00113          END IF
00114          DO i=1,nCameras
00115             IF (Projection%lReadCameraList) THEN
00116                CALL InputCamera(CAMERA_DATA_HANDLE, Projection%Camera)
00117             END IF
00118             IF (Projection%PlotLevel == MAXIMUMPLOTLEVEL) THEN
00119                PlotLevel=FinestLevel
00120             ELSE
00121                PlotLevel=min(Projection%PlotLevel,MaxLevel)
00122             END IF
00123             IF (.NOT. ASSOCIATED(Projection%Camera)) THEN
00124                axis=modulo(Projection%dim+(/0,1,2/),3)+1
00125                ALLOCATE(Projection%Data(levels(PlotLevel)%mx(axis(1)), levels(PlotLevel)%mx(axis(2))))
00126             ELSE
00127                ALLOCATE(Projection%data(Projection%Camera%res, nint(Projection%Camera%res*Projection%Camera%FOV(2)/Projection%Camera%FOV(1))))
00128             END IF
00129             Projection%Data=0d0
00130             IF (Projection%Field%Component==GASCOMP .OR. Projection%Field%Component==BOTHCOMP) THEN
00131                DO n=0, MaxLevel
00132                   Nodelist=>Nodes(n)%p
00133                   DO WHILE (ASSOCIATED(NodeList))
00134                      CALL ProcessProjection(Nodelist%self%info, Projection, axis, PlotLevel)
00135                      Nodelist=>Nodelist%next
00136                   END DO
00137                END DO
00138             END IF
00139             IF (MPI_ID == 0) THEN
00140                IF (Projection%Field%Component==PARTICLECOMP .OR. Projection%Field%Component==BOTHCOMP) THEN
00141                   IF (NrSinkParticles > 0) THEN 
00142                      ALLOCATE(Projection%ParticleData(NrSInkParticles, 3))
00143                      Projection%ParticleData=0d0
00144                      ParticleList=>SinkParticles
00145                      j=0
00146                      DO WHILE (ASSOCIATED(ParticleList))
00147                         j=j+1
00148                         IF (ASSOCIATED(Projection%shape)) THEN
00149                            IF (.NOT. IsInShape(Projection%shape, ParticleList%self%xloc, rpos, levels(0)%tnow)) THEN
00150                               ParticleList=>ParticleList%next
00151                               CYCLE
00152                            END IF
00153                         END IF
00154                         IF (ASSOCIATED(Projection%Camera)) THEN
00155                            Projection%ParticleData(j,:)=(GetPixel(Projection%Camera, ParticleList%self%xloc)-half)*projection%camera%fov(:)
00156                            
00157 !                           CALL BinParticle(Projection%Camera, ParticleList%self,Projection%ParticleData(i, :)) 
00158                            !Projection%data, GetParticleField(ParticleList%Self, Projection%Field%iD)**Projection%Pow)
00159                            
00160                            !                     ipos(1:2)=nint(GetPos(Projection%Camera, ParticleList%self%xloc)*shape(projection%data))
00161 !                     IF (ALL(ipos(1:2) >= 1) .AND. ALL(ipos(1:2) <= shape(projection%data))) THEN
00162 !                        Projection%data(ipos(1),ipos(2))=&
00163 !                             Projection%data(ipos(1),ipos(2))+ &
00164 !                             GetParticleField(ParticleList%Self, Projection%Field%iD)**Projection%Pow
00165                            !                     END IF
00166                         ELSE
00167                            Projection%ParticleData(j, :)=ParticleList%self%xloc(axis(1:2)) !(/ipos(axis(1)),ipos(axis(2))/)
00168 !                           ipos=max(1,min(levels(PlotLevel)%mX,nint((ParticleList%self%xloc-GxBounds(:,1))/levels(PlotLevel)%dx+half)))
00169 !                           Projection%data(ipos(axis(1)),ipos(axis(2)))=&
00170 !                                Projection%data(ipos(axis(1)),ipos(axis(2)))+ &
00171 !                                GetParticleField(ParticleList%Self, Projection%Field%iD)**Projection%Pow
00172 
00173                         END IF
00174                         Projection%ParticleData(j,3)=GetParticleField(ParticleList%Self, Projection%Field%iD)**Projection%Pow
00175                         ParticleList=>ParticleList%next
00176                      END DO
00177                      CALL OutputParticleData(Projection, axis, PlotLevel)
00178                      DEALLOCATE(Projection%ParticleData)
00179                   END IF
00180                END IF
00181             END IF
00182             CALL CollectProjection(Projection)
00183             CALL OutputProjection(Projection,axis,PlotLevel)
00184             DEALLOCATE(Projection%Data)
00185          END DO
00186          IF (Projection%lReadCameraList) THEN
00187             CLOSE(UNIT=CAMERA_DATA_HANDLE)
00188          END IF
00189 
00190          Projection=>Projection%next            
00191       END DO
00192    END SUBROUTINE ProcessProjections
00193 
00194    
00195    SUBROUTINE ProcessProjection(Info, Projection, axis, PlotLevel)
00196       TYPE(InfoDef) :: Info
00197       TYPE(ProjectionDef) :: Projection
00198       INTEGER :: i,j,k,l,axis(3), PlotLevel,ipos(3,2)
00199       REAL(KIND=qPREC) :: dv, pos(3), rpos(3)
00200       IF ((nDim == 1 .OR. nDim == 2) .AND. Projection%Dim == 3) THEN
00201          dv=1d0!levels(max(Info%level,PlotLevel))%dx
00202       ELSE
00203          dv=levels(Info%Level)%dx
00204       END IF
00205       ipos(3,:)=1
00206       DO i=1, Info%mx(1)
00207          ipos(1,:)=MapToLevel(Info%mGlobal(1,1)-1+i, Info%level, PlotLevel)
00208          DO j=1,Info%mx(2)
00209             ipos(2,:)=MapToLevel(Info%mGlobal(2,1)-1+j, Info%level, PlotLevel)
00210             DO k=1,Info%mx(3)
00211                IF (nDim == 3) ipos(3,:)=MapToLevel(Info%mGlobal(3,1)-1+k, Info%level, PlotLevel)
00212                IF (Info%level < MaxLevel) THEN
00213                   IF (Info%ChildMask(i,j,k) /= 0) THEN
00214                      CYCLE
00215                   END IF
00216                END IF
00217                pos=CellPos(Info, i, j, k)
00218                IF (ASSOCIATED(Projection%shape)) THEN
00219                   IF (.NOT. IsInShape(Projection%shape, pos, rpos, levels(Info%level)%tnow)) CYCLE
00220                END IF
00221                IF (ASSOCIATED(Projection%Camera)) THEN
00222                   CALL BinCell(Projection%Camera, pos, levels(Info%level)%dx, Projection%data, GetField(Info,i,j,k, Projection%Field%iD)**Projection%Pow)
00223                ELSE
00224                   Projection%data(ipos(axis(1),1):ipos(axis(1),2),ipos(axis(2),1):ipos(axis(2),2))=&
00225                        Projection%data(ipos(axis(1),1):ipos(axis(1),2),ipos(axis(2),1):ipos(axis(2),2))+ &
00226                        GetField(Info,i,j,k, Projection%Field%ID)**Projection%pow*dv
00227                END IF
00228             END DO
00229          END DO
00230       END DO
00231    END SUBROUTINE ProcessProjection
00232 
00233 
00234    SUBROUTINE CollectProjection(Projection)
00235       TYPE(ProjectionDef), POINTER :: Projection
00236       INTEGER :: iErr
00237       REAL(KIND=qPREC), DIMENSION(:), ALLOCATABLE :: totals
00238       IF (MPI_NP == 1) RETURN
00239       CALL MPI_ALLREDUCE(MPI_IN_PLACE, Projection%Data, size(Projection%Data), MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)
00240    END SUBROUTINE CollectProjection
00241 
00242 
00243    SUBROUTINE OutputProjection(Projection,axis,PlotLevel)
00244       TYPE(ProjectionDef), POINTER :: Projection
00245       INTEGER :: i,axis(3),PlotLevel
00246       CHARACTER(LEN=80) :: Name
00247       CHARACTER(LEN=15) :: powstring
00248       IF (MPI_ID == 0) THEN
00249          IF (Projection%pow /= 1) THEN
00250             WRITE(powstring,'(F5.2)') Projection%pow
00251             WRITE(powstring,'(2A)') '_to_the_', TRIM(ADJUSTL(powstring))
00252          ELSE
00253             WRITE(powstring,*) ''
00254          END IF
00255          IF (ASSOCIATED(Projection%Camera)) THEN
00256             IF (Projection%lReadCameraList) THEN
00257                WRITE(Name, '(A,A,A1,I5.5,A1,I5.5)') TRIM(GetName(Projection%Field)), TRIM(powstring), '_',current_frame, '_', Projection%Camera%iD
00258             ELSE
00259                WRITE(Name, '(A,A,A1,I5.5,A1,I5.5)') TRIM(GetName(Projection%Field)), TRIM(powstring), '_', Projection%Camera%iD, '_', current_frame
00260             END IF
00261          ELSE
00262             WRITE(Name, '(A,A,A7,I1.1,A1,I5.5)') TRIM(GetName(Projection%Field)), TRIM(powstring), '_along_', Projection%dim,'_',current_frame
00263          END IF
00264          IF (ASSOCIATED(Projection%Camera)) THEN
00265             CALL WriteBOV2DScalar(name, -Projection%Camera%FOV/2d0, Projection%Camera%FOV/2d0 , levels(0)%tnow, Projection%data, 'projection')
00266          ELSE
00267             CALL WriteBOV2DScalar(name, GxBounds(axis(1:2),1), max(GxBounds(axis(1:2),2),GxBounds(axis(1:2),1)+levels(PlotLevel)%dx), levels(0)%tnow, Projection%data, 'projection')
00268          END IF
00269          IF (ASSOCIATED(Projection%Image)) CALL OutputImage(Projection%Image, name, Projection%data)
00270       END IF
00271    END SUBROUTINE OutputProjection
00272 
00273    SUBROUTINE OutputParticleData(Projection, axis, PlotLevel)
00274       CHARACTER(LEN=80) :: Name
00275       CHARACTER(LEN=15) :: powstring
00276       TYPE(ProjectionDef), POINTER :: Projection
00277       INTEGER :: i,axis(3),PlotLevel
00278       IF (Projection%pow /= 1) THEN
00279          WRITE(powstring,'(F5.2)') Projection%pow
00280          WRITE(powstring,'(2A)') '_to_the_', TRIM(ADJUSTL(powstring))
00281       ELSE
00282          WRITE(powstring,*) ''
00283       END IF
00284       IF (ASSOCIATED(Projection%Camera)) THEN
00285          IF (Projection%lReadCameraList) THEN
00286             WRITE(Name, '(A4,A,A,A1,I5.5,A1,I5.5,A4)') 'out/', TRIM(GetName(Projection%Field)), TRIM(powstring), '_',current_frame, '_', Projection%Camera%iD, '.okc'
00287          ELSE
00288             WRITE(Name, '(A4,A,A,A1,I5.5,A1,I5.5,A4)') 'out/', TRIM(GetName(Projection%Field)), TRIM(powstring), '_', Projection%Camera%iD, '_', current_frame, '.okc'
00289          END IF
00290       ELSE
00291          WRITE(Name, '(A4,A,A,A7,I1.1,A1,I5.5,A4)') 'out/', TRIM(GetName(Projection%Field)), TRIM(powstring), '_along_', Projection%dim,'_',current_frame, '.okc'
00292       END IF
00293       
00294       
00295       OPEN (UNIT=11, file=Name, status="unknown")
00296 
00297       ! Always create 1 dummy particle to make visit happy
00298       write(11, '(3I6)') 4, NrSinkParticles, 4 !makes visit happy to have at least one particle when opening the database
00299       write(11, *) "x"
00300       write(11, *) "y"
00301       write(11, *) "z"
00302       write(11, *) trim(GetName(Projection%Field))
00303       
00304       DO i=1,2
00305          IF (ASSOCIATED(Projection%Camera)) THEN
00306             write(11,'(2E15.5)') -Projection%Camera%FOV(i)/2d0, Projection%Camera%FOV(i)/2d0 
00307          ELSE
00308             write(11,'(2E15.5)') GxBounds(axis(i),1), GxBounds(axis(i),2)
00309          END IF
00310       END DO
00311       IF (ASSOCIATED(Projection%Camera)) THEN 
00312          write(11,'(2E15.5)') Projection%Camera%FOV(1)/2d0/size(projection%data,1) * (/-1d0,1d0/)
00313       ELSE
00314          write(11,'(2E15.5)') GxBounds(axis(1),1)/2d0/size(projection%data,1)*(/-1d0,1d0/)
00315       END IF
00316 
00317       write(11,'(2E15.5)') minval(Projection%ParticleData(:,3)), maxval(Projection%ParticleData(:,3))
00318       DO i=1,NrSinkParticles
00319          write(11, '(100E24.16)') Projection%ParticleData(i,1:2), 0d0, Projection%ParticleData(i,3)
00320       END DO
00321       close(11)
00322    END SUBROUTINE OutputParticleData
00323 
00324 END MODULE Projections
 All Classes Files Functions Variables