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