C ++******************************************************************** C C COPYMRC MODIFIED FOR F90 10/22/97 yl C REMOVED REDLIN CALL APR 98 al C INMODE ALTERED MAY 00 al C SPEED UP JUN 01 al C TO MRC8 JUN 01 al C OPFILEC FEB 03 ARDEAN LEITH 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 COPYMRC(LUNSPI,LUNMRC) C C PURPOSE: CONVERTS SPIDER IMAGES TO OR FROM MRC FORMAT C C THE MRC FILE IS OPENED IN BINARY FORMAT. C THE DATA IN THE FILE WAS WRITTEN IN BYTE FORMAT AS FOLLOW: C MODE 0 : IMAGE STORED AS INTEGER*1 C 1 : IMAGE STORED AS INTEGER*2 C 2 : IMAGE STORED AS REALS C C23456789012345678901234567890123456789012345678901234567890123456789012 C*********************************************************************** SUBROUTINE COPYMRC(LUNSPI,LUNMRC,NSAM,NROW,NSLICE) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' COMMON /IOERR/ IERR COMMON /IOBUF/ BUFIN(NBUFSIZ) INTEGER * 1 I1BUF COMMON BUF(NBUFSIZ),FIXLENBUF(256),I1BUF(1024) CHARACTER(LEN=MAXNAM) :: FILNAM,MRCFILE CHARACTER(LEN=1) :: NULL,ANS LOGICAL :: FOLD,FLIP INTEGER * 2 I2VAL NULL = CHAR(0) IF (FCHAR(4:11) .EQ. 'TO MRC8') GOTO 2000 IF (FCHAR(4:5) .EQ. 'TO') GOTO 1000 C COPY FROM MRC TO SPIDER FILE FORMAT ------------------FROM MRC C OPEN MRC FILE AS DIRECT ACCESS, UNFORMATTED, RECL= 1024 BYTES LENREC = 1024 CALL OPAUXFILE(.TRUE.,MRCFILE,DATEXC,LUNMRC,LENREC,'O', & 'MRC INPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN READ(LUNMRC,REC=1,IOSTAT=IERR) FIXLENBUF IF (IERR .NE. 0) THEN CALL ERRT(102,'SYSTEM READ ERROR IN MRC HEADER',IERR) GOTO 9999 ENDIF C PARSE THE MRC HEADER CALL REDHEDMRC(FIXLENBUF,NSAM,NROW,NSLICE,MODE,FMIN,FMAX,AV) C OPEN SPIDER OUTPUT FILE ITYPE = 1 IF (NSLICE .GT. 1) ITYPE = 3 MAXIM = 0 CALL OPFILEC(0,.TRUE.,FILNAM,LUNSPI,'U',ITYPE,NSAM,NROW,NSLICE, & MAXIM,'SPIDER OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 C EXTRACT DATA FROM MRC FILE AFTER HEADER & PUT IN SPIDER FILE IOFFSET = 1024 C NPIX = TOTAL NUMBER OF PIXELS IN MRC FILE NPIX = NSAM * NROW * NSLICE C CLOSE MRC FILE CLOSE(LUNMRC) IF (MODE .EQ. 0) THEN C 8 BIT INTEGER MRC INPUT FILE INMODE = 8 C REOPEN MRC FILE WITH LENREC = 1 BYTE, DIRECT, FORMATTED LENOPEN = NSAM CALL OPAUXFILE(.FALSE.,MRCFILE,NULL,LUNMRC,LENOPEN,'O', & ' ',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL RAW8TOSPI(LUNMRC,LUNSPI,NSAM,NPIX,IOFFSET,.TRUE., & LENOPEN,BUF,IRTFLG) ELSEIF (MODE .EQ. 1) THEN C 16 BIT INTEGER MRC FILE (HEADER LENGTH DIVISABLE BY TWO) C REOPEN MRC FILE AS NSAM*2 BYTE, DIRECT ACCESS, UNFORMATTED LENOPEN = NSAM * 2 CALL OPAUXFILE(.FALSE.,MRCFILE,NULL,LUNMRC,LENOPEN,'O', & ' ',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL RDPRMC(ANS,NCHAR,.TRUE., & 'FLIP DATA BYTE ORDERING? (Y/N)',NULL,IRT) IF (IRTFLG .NE. 0) GOTO 9999 FLIP = (ANS .EQ. 'Y') FOLD = .TRUE. CALL RAW16TOSPI(LUNMRC,LUNSPI,NSAM,NPIX,IOFFSET,FLIP, & FOLD,LENOPEN,BUF,IRTFLG) ELSEIF (MODE .EQ. 2) THEN C 32 BIT FOATING POINT IMAGE C REOPEN MRC FILE AS NSAM*4 BYTE, DIRECT ACCESS, UNFORMATTED LENOPEN = NSAM * 4 CALL OPAUXFILE(.FALSE.,MRCFILE,NULL,LUNMRC,LENOPEN,'O', & ' ',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL RDPRMC(ANS,NCHAR,.TRUE., & 'FLIP DATA BYTE ORDERING? (Y/N)',NULL,IRT) IF (IRTFLG .NE. 0) GOTO 9999 FLIP = (ANS .EQ. 'Y') NFLIP = 0 IF (FLIP) NFLIP = -1 CALL RAW32TOSPI(LUNMRC,LUNSPI,NSAM,NPIX, & IOFFSET,NFLIP,LENOPEN,BUF,IRTFLG) ELSE WRITE(NOUT,*)'MRC MODE: ',MODE, & ' CAN NOT BE COPIED TO SPIDER' CALL ERRT(100,'COPYMRC',NE) ENDIF GOTO 9999 C COPY FROM SPIDER TO MRC FILE FORMAT -------------------- TO MRC 1000 CONTINUE C OPEN A NEW FILE FOR THE MRC FORMAT USING DIRECT ACCESS C RECORD LENGTH IS 4 BYTES CALL OPAUXFILE(.TRUE.,MRCFILE,DATEXC,LUNMRC,4,'N', & 'MRC OUTPUT',.TRUE.,IRTFLG) C CREATE A NEW HEADER FOR THE MRC FILE C WRITE HEADER. (NOTE: FMIN, FMAX, AV ARE SAME AS SPIDER IMAGE) CALL WRTHEDMRC(MRCFILE, NSAM, NROW, NSLICE, & LUNMRC,BUF,FMIN,FMAX,AV,2,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 C REOPEN MRC FILE FOR DIRECT ACCESS, RECORD LENGTH 1024 BYTES CLOSE(LUNMRC) LENREC = 1024 CALL OPAUXFILE(.FALSE.,MRCFILE,NULL,LUNMRC,LENREC,'O', & ' ',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 C SET STARTING RECORD FOR MRC DATA IRECOUT = 1 ILOCOUT = 0 DO IRECIN = 1,NROW * NSLICE C READ EACH ROW OF SPIDER INPUT FILE CALL REDLIN(LUNSPI,BUFIN,NSAM,IRECIN) C PUT ROW OUT TO MRC FILE DO ILOCIN=1,NSAM ILOCOUT = ILOCOUT + 1 BUF(ILOCOUT) = BUFIN(ILOCIN) IF (ILOCOUT .GE. 256) THEN C PUT OUT COMPLETED RECORD IRECOUT = IRECOUT + 1 CALL WRTLIN(LUNMRC,BUF,256,IRECOUT) IF (IERR .NE. 0) THEN CALL ERRT(102,'WRITING RECORD',IRECOUT) GOTO 9999 ENDIF ILOCOUT = 0 ENDIF ENDDO ENDDO IF (ILOCOUT .GT. 0) THEN C PUT OUT REMAINING RECORD IRECOUT = IRECOUT + 1 CALL WRTLIN(LUNMRC,BUF,ILOCOUT,IRECOUT) IF (IERR .NE. 0 .AND. IERR .NE. 253) THEN CALL ERRT(102,'WRITING RECORD',IRECOUT) GOTO 9999 ENDIF ENDIF GOTO 9999 C COPY FROM SPIDER TO MRC8 FILE FORMAT ----------------- TO MRC8 2000 CONTINUE C OPEN A NEW FILE FOR THE MRC FORMAT USING DIRECT ACCESS C RECORD LENGTH IS 4 BYTES CALL OPAUXFILE(.TRUE.,MRCFILE,DATEXC,LUNMRC,4,'N', & 'MRC OUTPUT',.TRUE.,IRTFLG) C CREATE A NEW HEADER FOR THE MRC FILE FN = (255.0 - 0.0) / (FMAX - FMIN) FNCON = 0.0 - FN * FMIN FMIN8 = 0.0 FMAX8 = 255.0 I2VAL = FMIN * FN + FNCON AV8 = I2VAL C WRITE HEADER. CALL WRTHEDMRC(MRCFILE, NSAM, NROW, NSLICE, & LUNMRC,BUF,FMIN8,FMAX8,AV8,0,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 C REOPEN MRC FILE FOR DIRECT ACCESS, RECORD LENGTH 1024 BYTES CLOSE(LUNMRC) LENREC = 1024 CALL OPAUXFILE(.FALSE.,MRCFILE,NULL,LUNMRC,LENREC,'O', & ' ',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 C SET STARTING RECORD FOR MRC DATA IRECOUT = 1 ILOCOUT = 0 DO IRECIN = 1,NROW * NSLICE C READ EACH ROW OF SPIDER INPUT FILE CALL REDLIN(LUNSPI,BUFIN,NSAM,IRECIN) C PUT ROW OUT TO MRC FILE DO ILOCIN=1,NSAM ILOCOUT = ILOCOUT + 1 I2VAL = BUFIN(ILOCIN) * FN + FNCON I1BUF(ILOCOUT) = I2VAL IF (ILOCOUT .GE. LENREC) THEN C PUT OUT COMPLETED RECORD IRECOUT = IRECOUT + 1 CALL WRTLIN8(LUNMRC,I1BUF,LENREC,IRECOUT) IF (IERR .NE. 0) THEN CALL ERRT(102,'WRITING RECORD',IRECOUT) GOTO 9999 ENDIF ILOCOUT = 0 ENDIF ENDDO ENDDO IF (ILOCOUT .GT. 0) THEN C PUT OUT REMAINING RECORD IRECOUT = IRECOUT + 1 CALL WRTLIN8(LUNMRC,I1BUF,ILOCOUT,IRECOUT) IF (IERR .NE. 0 .AND. IRTFLG .NE. 253) THEN CALL ERRT(102,'WRITING RECORD',IRECOUT) GOTO 9999 ENDIF ENDIF 9999 CLOSE(LUNSPI) CLOSE(LUNMRC) RETURN END