Scrambler  1
movies.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 !    movies.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 Movies
00024    USE GlobalDeclarations
00025    USE Cameras
00026    USE Splines
00027    
00028    TYPE MovieDef
00029       TYPE(pSplineDef), DIMENSION(3) :: positions
00030       TYPE(pSplineDef), DIMENSION(3) :: focii
00031       TYPE(pSplineDef), DIMENSION(3) :: UpVectors
00032       INTEGER :: iFrame = 0
00033       INTEGER :: nFrames = 0
00034       REAL(KIND=qPREC), DIMENSION(:), POINTER :: times
00035    END type MovieDef
00036 
00037    CONTAINS
00038 
00039    SUBROUTINE InitMovie(Movie,nframes)
00040       TYPE(MovieDef), POINTER :: Movie
00041       INTEGER :: nframes
00042       REAL(KIND=qPREC), DIMENSION(:), POINTER :: times
00043       ALLOCATE(Movie)
00044       ALLOCATE(Movie%times(nframes))
00045       Movie%nframes=nframes
00046       DO i=1,3
00047          ALLOCATE(movie%positions(i)%p)
00048          ALLOCATE(movie%focii(i)%p)
00049          ALLOCATE(movie%upvectors(i)%p)
00050          Movie%positions(i)%p%x=>Movie%times
00051          Movie%focii(i)%p%x=>Movie%times
00052          Movie%upVectors(i)%p%x=>Movie%times
00053          ALLOCATE(Movie%positions(i)%p%y(nframes))
00054          ALLOCATE(Movie%focii(i)%p%y(nframes))
00055          ALLOCATE(Movie%UpVectors(i)%p%y(nframes))
00056       END DO
00057       Movie%iframe=0
00058    END SUBROUTINE InitMovie
00059 
00060 
00061    SUBROUTINE AddMovieCamera(Movie, Camera, time)
00062       TYPE(CameraDef) :: Camera
00063       TYPE(MovieDef) :: Movie
00064       REAL(KIND=qPREC) :: time
00065       INTEGER :: n, i
00066       n=Movie%iframe+1
00067       IF (n > Movie%nFrames) THEN
00068          write(*,*) 'Not enough frames initialized for movie - ignoring movie point'
00069          RETURN
00070       END IF
00071       Movie%iframe=n
00072       Movie%times(n)=time
00073       DO i=1,3
00074          Movie%positions(i)%p%y(n)=Camera%pos(i)
00075          Movie%focii(i)%p%y(n)=Camera%focus(i)
00076          Movie%upvectors(i)%p%y(n)=Camera%upvector(i)
00077       END DO
00078    END SUBROUTINE AddMovieCamera
00079 
00080 
00081    SUBROUTINE FinalizeMovie(Movie)
00082       INTEGER :: i
00083       TYPE(MovieDef) :: Movie
00084       DO i=1,3
00085          CALL SolveSpline(movie%positions(i)%p)
00086          CALL SolveSpline(movie%focii(i)%p)
00087          CALL SolveSpline(movie%upvectors(i)%p)
00088       END DO
00089    END SUBROUTINE FinalizeMovie
00090 
00091    SUBROUTINE UpdateMovieCamera(Movie, Camera)
00092       TYPE(CameraDef) :: Camera
00093       TYPE(MovieDef) :: Movie
00094       INTEGER :: i
00095       DO i=1,3
00096          Camera%pos(i)=GetSplineValue(Movie%positions(i)%p, levels(0)%tnow)
00097          Camera%focus(i)=GetSplineValue(Movie%focii(i)%p, levels(0)%tnow)
00098          Camera%upvector(i)=GetSplineValue(Movie%upvectors(i)%p, levels(0)%tnow)
00099       END DO
00100       CALL UpdateMatrix(Camera)
00101    END SUBROUTINE UpdateMovieCamera
00102 
00103 END MODULE Movies
 All Classes Files Functions Variables