Scrambler
1
|
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