Scrambler
1
|
00001 !######################################################################### 00002 ! 00003 ! Copyright (C) 2003-2012 Department of Physics and Astronomy, 00004 ! University of Rochester, 00005 ! Rochester, NY 00006 ! 00007 ! images.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 Images 00024 USE GlobalDeclarations 00025 USE PhysicsDeclarations 00026 USE ProcessingDeclarations 00027 USE IOPPM 00028 IMPLICIT NONE 00029 00030 INTEGER, PARAMETER :: MaxCMapPoints=10 00031 00032 TYPE ImageDef 00033 REAL(KIND=qPREC) :: minvalue=MINOVERALL 00034 REAL(KIND=qPREC) :: maxvalue=MAXOVERALL 00035 INTEGER :: Scaling=LINEARSCALE 00036 INTEGER, DIMENSION(MaxCMapPoints,3) :: cmap=reshape((/ 00037 0, 0, 0, 00038 0, 0, 255, 00039 0, 255, 255, 00040 0, 255, 0, 00041 255, 255, 0, 00042 255, 0, 0, 00043 0, 0, 0, 00044 0, 0, 0, 00045 0, 0, 0, 00046 0, 0, 0/), (/MaxCMapPoints,3/),(/0/), (/2,1/)) 00047 INTEGER :: npoints=6 00048 END type ImageDef 00049 00050 CONTAINS 00051 00052 00053 SUBROUTINE OutputImage(Image, name, data) 00054 USE IOPPM 00055 TYPE(ImageDef), POINTER :: Image 00056 REAL(KIND=qPREC) :: minvalue, maxvalue 00057 CHARACTER(LEN=88) :: FileName 00058 CHARACTER(LEN=*) :: name 00059 REAL(KIND=qPREC), DIMENSION(:,:) :: data 00060 IF (Image%minvalue==MINOVERALL) THEN 00061 minvalue=minval(data) 00062 ELSE 00063 minvalue=Image%minvalue 00064 END IF 00065 IF (Image%maxvalue==MAXOVERALL) THEN 00066 maxvalue=maxval(data) 00067 ELSE 00068 maxvalue=Image%maxvalue 00069 END IF 00070 WRITE(FileName,'(A4,A,A4)') 'out/', TRIM(NAME),'.ppm' 00071 IF (Image%Scaling==LOGSCALE) THEN 00072 CALL WritePPM(TRIM(Filename), Image%cmap(1:Image%npoints,:), log10(data), log10(minvalue),log10(maxvalue)) 00073 ELSE 00074 CALL WritePPM(TRIM(FileName), Image%cmap(1:Image%npoints,:), data, minvalue,maxvalue) 00075 END IF 00076 END SUBROUTINE OutputImage 00077 00078 END MODULE Images