#if defined(__APPLE__) C THIS ROUTINE UNAVAILABLE ON APPLE MAC SUBROUTINE unixtovv(LUNO,LUNN,NMIN,NMAX,NSAM,NROW,NSLICE,IRTFLG) COMMON /UNITS/LUNC,NIN,NOUT WRITE(NOUT,*) ' HELP OPERATION NOT AVAILABLE ON THIS OS' RETURN END #else #if defined (SP_NT) || defined (__osf__) || defined (SP_SUN4) || defined (__linux__) C THIS ROUTINE SPECIFIC TO UNIX SPIDER AND IS NOT C USED AT VAX, SUN, OR NT SITES SUBROUTINE unixtovv(LUNO,LUNN,NMIN,NMAX,NSAM,NROW,NSLICE,IRTFLG) COMMON /UNITS/LUNC,NIN,NOUT WRITE(NOUT,*) ' HELP OPERATION NOT AVAILABLE ON THIS OS' RETURN END #else C++********************************************************************* C C UNIXTOVV.F -- JAN 94 al C C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2005 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 UNIXTOVV(FILOLD,LUNO,LUNN,NMIN NMAX,IRTFLG) C C PURPOSE: TO CONVERT A UNIX 32 BIT IMAGE FILE TO VOXEL-VIEW C FORMAT C C PARAMETERS: C FILOLD EXISTING FILE NAME C FILNEW UNIX 8 BIT SPIDER FILE NAME C LUNO LOGICAL UNIT NUMBER TO BE ASSIGNED TO FILOLD. C LUNN LOGICAL UNIT NUMBER TO BE ASSIGNED TO FILNEW C NMIN,NMAX NORMALIZATION INTERVAL (USUALLY 0..255) C C IRTFLG ERROR RETURN FLAG. (0 IS NORMAL) C C 0 2 3 4 5 6 7 C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE UNIXTOVV(LUNO,LUNN,NMIN,NMAX,NSAM,NROW,NSLICE,IRTFLG) INCLUDE 'CMBLOCK.INC' INTEGER * 1 LBUF(32000) REAL BUFO(16000) COMMON BUFO,LBUF CHARACTER *100 FILNEW CHARACTER *80 NEWDIR CHARACTER * 1 NULL,ANS INTEGER ACCESS INTEGER * 2 I2VAL NULL = CHAR(0) C CHECK 32 BIT UNIX SPIDER INPUT FILE IF (IMAMI .EQ. 0) THEN C MUST NORMALIZE INPUT IMAGE FIRST CALL NORM3(LUNO,NSAM,NROW,NSLICE,FMAX,FMIN,AV) ENDIF IF (IFORM .NE. 3) THEN WRITE(NOUT,*) & 'WARNING: CONVERTER NOT TESTED FOR THIS FORMAT:',IFORM ENDIF 20 TMIN = FMIN TMAX = FMAX CALL RDPRM2S(TMIN,TMAX,NOT_USED, & 'ENTER THRESHOLD MIN AND MAX ( KEEPS FILE VALUES)',IRTFLG) IF (IRTFLG .EQ. -1) RETURN C NORMALIZE OVER THE RANGE NMIN.....NMAX FN = (NMAX - NMIN) / (TMAX - TMIN) FNCON = NMIN - FN * TMIN C KEEP CASE OF INPUT FOR DIRECTORY NAME 30 IRTFLG = -999 CALL RDPRMC(NEWDIR,NCHAR,.FALSE., & 'ENTER OUTPUT DIRECTORY',NULL,IRTFLG) IF (IRTFLG .EQ. -1) GOTO 20 C CREATE DIRECTORY IF NEEDED IERR = ACCESS(NEWDIR(1:NCHAR),' ') IF (IERR .NE. 0) THEN IERR = MKDIR(NEWDIR(1:NCHAR),509) IF (IERR .NE. 0) THEN WRITE(NOUT,96) NEWDIR(1:NCHAR) 96 FORMAT(' *** ERROR CREATING NEW DIRECTORY: ',A) GOTO 30 ELSE WRITE(NOUT,98) NEWDIR 98 FORMAT(' CREATED NEW DIRECTORY: ',A) ENDIF ENDIF FILNEW(1:NCHAR+1) = NEWDIR(1:NCHAR) // '/' DO ISLICE = 1,NSLICE C OPEN NEW VOXEL-VIEW FILE CALL INTTOCHAR(ISLICE,FILNEW(NCHAR+2:),ILEN,1) C NULL TERMINATE THE FILE NAME. FILNEW(NCHAR+ILEN+2:NCHAR+ILEN+2) = NULL CLOSE(LUNN) CALL OPAUXFILE(.FALSE.,FILNEW,NULL,LUNN,NSAM,'N', & ' ',.TRUE.,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN IREC1 = (ISLICE -1) * NROW + 1 IREC1M1 = IREC1 - 1 DO IREC =IREC1, IREC1 + NROW -1 C READ EACH RECORD OF 32 BIT UNIX SPIDER INPUT FILE CALL REDLIN(LUNO,BUFO,NSAM,IREC) C CONVERT FLOATING POINT NUMBERS TO -128...127 LOGICAL *1 DO J=1,NSAM FVAL = BUFO(J) C THRESHOLD THE VALUES FVAL = AMIN1(AMAX1(FVAL,TMIN),TMAX) I2VAL = FVAL * FN + FNCON LBUF(J) = I2VAL ENDDO C WRITE OUPUT RECORD TO DISK CALL WRTLIN8(LUNN,LBUF,NSAM,IREC-IREC1M1) ENDDO ENDDO WRITE(NOUT,92) NSLICE,NSAM,NROW 92 FORMAT(' OUTPUT: ',I4,' IMAGES OF SIZE: (',I4,',',I4,')', & ' AND _dimensions file'/) C SET NAME FOR _dimensions FILE FILNEW(1:NCHAR+13) = NEWDIR(1:NCHAR) // '/_dimensions' // NULL CLOSE(LUNN) CALL OPAUXFILE(.FALSE.,FILNEW,NULL,LUNN,0,'N', & ' ',.TRUE.,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN WRITE(LUNN,900) 900 FORMAT( & '*********** VoxelView Data Set Descriptor File ', & '(field format shown): ***********') WRITE(LUNN,901) 901 FORMAT( & '* [zsize] [xsize] [ysize] [interps]', & ' [bits/voxel] *') WRITE(LUNN,902) 902 FORMAT( & '* [zoffset] [xoffset] [yoffset] [voffset]', & ' *') WRITE(LUNN,903) 903 FORMAT( & '* [zscale] [xscale] [yscale] [vscale]', & ' *') WRITE(LUNN,904) 904 FORMAT( & '* [zunits] [xunits] [yunits] [vunits]', & ' *') WRITE(LUNN,905) 905 FORMAT( & '* [zlabel] [xlabel] [ylabel] [vlabel]', & ' *') WRITE(LUNN,906) 906 FORMAT( & '************** This header must also remain in the file', & ' VERBATIM!! *************') WRITE(LUNN,907) NSLICE,NSAM,NROW 907 FORMAT(I3,11X,I5,11X,I5,' 0 8 ') WRITE(LUNN,908) 908 FORMAT( & '0.0 0.0 0.0 0.0 ') WRITE(LUNN,909) 909 FORMAT( & '0.5 0.5 0.5 0.003906') WRITE(LUNN,910) 910 FORMAT( & 'mm mm mm * ') WRITE(LUNN,911) 911 FORMAT( & 'axial saggital coronal density ') CLOSE(LUNN) C SET FLAG FOR NORMAL RETURN NSAMC = NSAM NROWC = NROW IRTFLG = 0 RETURN END #endif #ifdef NEVER C EQUIVALENCE METHOD REMOVED BECAUSE MIPS 7.0 COMPILERS C OPTIMIZE IT AWAY ON -O2 !!!!!!!! LOGICAL * 1 LBUF(32000),LVAL(2),LVAL1,LVAL2 EQUIVALENCE (LVAL,I2VAL),(LVAL2,LVAL(2)) I2VAL = FVAL * FN + FNCON LBUF(J) = LVAL2 #endif #endif