Scrambler  1
io_ppm.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 !    io_ppm.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 !#########################################################################
00025 
00029 
00032 MODULE IOPPM
00033    USE GlobalDeclarations
00034    IMPLICIT NONE
00035 
00036 CONTAINS
00037 
00038    SUBROUTINE WritePPM(Filename, colormap, data, cmin, cmax)
00039       CHARACTER(LEN=*) :: Filename
00040       CHARACTER(LEN=210) :: system_cmd
00041       REAL(KIND=qPREC), DIMENSION(:,:) :: data
00042       REAL(KIND=qPREC) :: cmin, cmax
00043       INTEGER, DIMENSION(:,:) :: colormap
00044       INTEGER :: i,j
00045       OPEN(UNIT=PPM_DATA_HANDLE, FILE=TRIM(FileName), status="unknown")
00046       write(PPM_DATA_HANDLE,'(A,3I6)') 'P3 ',shape(data), 255
00047       DO j=size(data,2),1,-1
00048          DO i=1,size(data,1)
00049             write(PPM_DATA_HANDLE,'(3I5)') RGBInterp(data(i,j),cmin, cmax,colormap)
00050          END DO
00051       END DO
00052       CLOSE(PPM_DATA_HANDLE)
00053  !     j=len(trim(FileName))
00054 !      write(system_cmd,'(A8,A,A1,A,A12,A)') 'convert ',TRIM(FileName), ' ', FileName(1:j-4), '.jpeg && rm ', TRIM(FILENAME)
00055 !      write(*,*) system_cmd
00056 !      CALL SYSTEM(system_cmd)
00057 
00058    END SUBROUTINE WritePPM
00059 
00060    FUNCTION RGBInterp(x,cmin,cmax,colormap)
00061       REAL(KIND=qPREC) :: x,dx,f,cmin,cmax
00062       INTEGER :: i2,i1
00063       INTEGER, DIMENSION(:,:) :: colormap
00064       INTEGER, DIMENSION(3) :: RGBInterp
00065       dx=(cmax-cmin)/real(size(colormap,1)-1)
00066       i2=min(size(colormap,1),max(ceiling((x-cmin)/dx)+1,2))
00067       i1=i2-1
00068       f=(x-cmin)/dx+1-i1
00069       RGBInterp=NINT(colormap(i1,:)*(1d0-f)+f*colormap(i2,:))
00070       RGBInterp=max((/0,0,0/),min((/255,255,255/),RGBInterp))
00071 
00072 !      IF (x /= 0d0) THEN
00073 !         write(*,*) dx, cmin, cmax, RGBInterp
00074 !         STOP
00075 !      END IF
00076    END FUNCTION RGBInterp
00077 
00078 END MODULE IOPPM
00079 
00080 
 All Classes Files Functions Variables