#if defined(SP_SUN4) C THIS ROUTINE DID NOT COMPILE ON SUN SUBROUTINE spdtotiff COMMON /UNITS/LUNC,NIN,NOUT WRITE(NOUT,*) 'DUMMY CALL: spdtotiff' RETURN END #else C++********************************************************************* C C SPDTOTIFF.FOR -- CREATED, DEC 28, 94 al C OSF REMOVED JUL 2009 ArDean Leith C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2009 Health Research Inc. * C=* * C=* HEALTH RESEARCH INCORPORATED (HRI), * C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455. * C=* * C=* Email: spider@wadsworth.org * C=* * C=* This program is free software; you can redistribute it and/or * C=* modify it under the terms of the GNU General Public License as * C=* published by the Free Software Foundation; either version 2 of the * C=* License, or (at your option) any later version. * C=* * C=* This program is distributed in the hope that it will be useful, * C=* but WITHOUT ANY WARRANTY; without even the implied warranty of * C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * C=* General Public License for more details. * C=* * C=* You should have received a copy of the GNU General Public License * C=* along with this program; if not, write to the * C=* Free Software Foundation, Inc., * C=* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * C=* * C ********************************************************************** C C SPDTOTIFF(LUNO,LUNN,NSAM,NROW,NSLICE,IRTFLG) C C PURPOSE: CONVERT A SPIDER IMAGE FILE TO TIFF FORMAT C C PARAMETERS: C LUNO LOGICAL UNIT NUMBER TO BE ASSIGNED INPUT. C LUNN LOGICAL UNIT NUMBER TO BE ASSIGNED TO FILNEW C IRTFLG ERROR RETURN FLAG. (0 IS NORMAL) C C TIFF TAGS ------------------------- C TIFFTAG_IMAGEWIDTH 256 C TIFFTAG_IMAGELENGTH 257 C TIFFTAG_BITSPERSAMPLE 258 C TIFFTAG_COMPRESSION 259 C TIFFTAG_PHOTOMETRIC 262 C TIFFTAG_STRIPOFFSETS 273 C TIFFTAG_ROWSPERSTRIP 278 C TIFFTAG_STRIPBYTECOUNTS 279 C TIFFTAG_RESOLUTIONUNIT 296 C C--******************************************************************** SUBROUTINE SPDTOTIFF(LUNO,LUNN,NSAM,NROW,NSLICE,IRTFLG) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' COMMON /IOERR/ IERR CHARACTER (LEN=MAXNAM) :: FILNEW REAL BUFO INTEGER*1 LBUF COMMON BUFO(17000),LBUF(1) C THE BUFFER FOR TIFF INTEGER*2 TIFFINT(70),TIFFDAT(70) INTEGER*1 TIFFBYTE(140) EQUIVALENCE (TIFFINT, TIFFBYTE) LOGICAL :: FLIP,ISSWAB LOGICAL*1 LVAL REAL IPVAL CHARACTER * 1 NULL LOGICAL EX INTEGER*1 LTEMP C SET THE TIFFINT INVARIANT HEADER C BYTE ORDER, VERSION(=42), OFFSET TO IFD, IFD COUNT C DIRECTORY ENTRIES: TAG #, TYPE(3=SHORT,4=LONG), C LENGTH(4 BYTES),VALUE(4 BYTES) DATA TIFFDAT/19789,42,0,8,9, 1 256,4,0,1,0,0, 257,4,0,1,0,0, 1 258,3,0,1,8,0, 259,3,0,1,1,0, 1 262,3,0,1,1,0, 273,4,0,1,0,1024, 1 278,4,0,1,0,0, 279,4,0,1,0,0, 1 296,3,0,1,3,0, 11*0/ NULL = CHAR(0) IRTFLG = 1 C INITIALIZE THE TIFF HEADER WITH CONSTANT VALUES DO I=1,70 TIFFINT(I) = TIFFDAT(I) ENDDO C CHECK THE FILE SIZE. IF IT IS TOO BIG, JUST RETURN IF ((NSAM .GT. 8192) .OR. (NROW .GT. 8192)) THEN WRITE(NOUT,*) ' *** IMAGE TOO LARGE' CALL ERRT(100,'SPDTOTIFF',NE) RETURN ENDIF C CONVERT SPIDER HEADER TO TIFF HEADER C TIFFTAG_IMAGEWIDTH 256 TIFFINT(11) = NSAM C TIFFTAG_IMAGELENGTH 257 TIFFINT(17) = NROW C TIFFTAG_STRIPOFFSETS 273 TIFFINT(41) = 512 C TIFFTAG_ROWSPERSTRIP 278 TIFFINT(47) = NROW C TIFFTAG_STRIPBYTECOUNTS 279 TIFFINT(52) = NSAM*NROW/65536.0 TIFFINT(53) = NSAM*NROW C NORMALIZE INPUT IMAGE FIRST IF (IMAMI .EQ. 0)CALL NORM3(LUNO,NSAM,NROW,NSLICE,FMAX,FMIN,AV) C COMPUTE THE SCALE VALUE IPVAL = 255.0 / (FMAX - FMIN) C GET OUTPUT FILE NAME C OPEN NEW FILE FOR TIFF VERSION, 1024 BYTE RECORD LENGTH LENOPN = 1024 CALL OPAUXFILE(.TRUE.,FILNEW,'tif',LUNN,LENOPN,'N', & 'TIFF OUTPUT',.TRUE.,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN C CHECK THE DATA IS AN IMAGE OR A VOLUME C IF IT IS AN IMAGE, CONVERT IT TO A TIFF FILE C IF IT IS A VOLUME, ASK THE USER WHICH SLICE SHOULD BE CONVERTED IF (ABS(NSLICE) .LE. 1) THEN C IT IS AN IMAGE .... ISLICE = 1 ELSEIF (ABS(NSLICE) .GT. 1) THEN C IT IS A VOLUME, ASK FOR THE SLICE NO. THAT WILL BE CONVERTED CALL RDPRI1S(ISLICE,NOT_USED, 'SLICE NUMBER',IRTFLGT) IF (IRTFLGT .NE. 0) RETURN ENDIF ISTREC = (ISLICE - 1) * NROW + 1 IENDREC = ISTREC + NROW - 1 C WRITE THE TIFF HEADER C FLIP THE HEADER'S BYTES ON LINUX DO K= 1, 140,2 LBUF(K+1) = TIFFBYTE(K) LBUF(K) = TIFFBYTE(K+1) ENDDO DO K= 141, 512 LBUF(K) = 0 ENDDO C FIND IF CURRENTLY SWAPPING BYTES FLIP = ISSWAB(99) C LBUF HAS 512 BYTES IN IT NOW FROM TIFF HEADER K = 512 IRECOUT = 0 IERR = 0 DO I = ISTREC,IENDREC C READ EACH RECORD OF SPIDER FILE CALL REDLIN(LUNO,BUFO,NSAM,I) IF (IERR .NE. 0) THEN CALL ERRT(101,'READING FILE',NE) RETURN ENDIF C CONVERT FLOATING POINT NUMBERS TO BYTE DO J=1,NSAM IF (K .GE. LENOPN) THEN C BUFFER IS FULL, PUT IT OUT TO FILE IRECOUT = IRECOUT + 1 CALL WRTLIN8(LUNN,LBUF,LENOPN,IRECOUT) K = 0 ENDIF K = K + 1 LBUF(K) = (BUFO(J) - FMIN) * IPVAL ENDDO ENDDO IF (K .GT. 0) THEN C BUFFER STILL HAS PIXELS IN IT, PUT THEM OUT TO FILE IRECOUT = IRECOUT + 1 CALL WRTLIN8(LUNN,LBUF,K,IRECOUT) ENDIF NLET = LNBLNKN(FILNEW) WRITE(NOUT,*) ' OUTPUT PLACED IN: ',FILNEW(1:NLET) C SET FLAG FOR NORMAL RETURN IRTFLG = 0 WRITE(6,*) ' UNFLIPPED OUTPUT' RETURN END #endif