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 NPIX8 DEC 08 ArDean Leith C INTEL BYTE_ORDER JUL 09 ARDEAN LEITH C C ********************************************************************** C=* * C=* This file is part of: SPIDER - Modular Image Processing System. * C=* SPIDER System Authors: Joachim Frank & ArDean Leith * C=* Copyright 1985-2010 Health Research Inc., * C=* Riverview Center, 150 Broadway, Suite 560, Menands, NY 12204. * C=* Email: spider@wadsworth.org * C=* * C=* SPIDER 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=* SPIDER 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=* You should have received a copy of the GNU General Public License * C=* along with this program. If not, see * 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(1024) REAL :: BUF(NBUFSIZ),FIXLENBUF(256) CHARACTER(LEN=MAXNAM) :: FILNAM,MRCFILE CHARACTER(LEN=1) :: NULL,ANS INTEGER * 2 :: I2VAL INTEGER * 8 :: NPIX8 LOGICAL :: FOLD,FLIP,ISSWABT,ISSWAB NULL = CHAR(0) ISSWABT = ISSWAB(99) 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,FLIP) ! write(6,*) ' nsam,mode,flip: ',nsam,mode,flip ISSWABT = ISSWAB(99) IF (ISSWABT) FLIP = .NOT. FLIP 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 NPIX8 = TOTAL NUMBER OF PIXELS IN MRC FILE NPIX8 = NSAM * NROW NPIX8 = NPIX8 * 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,NPIX8,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 FOLD = .TRUE. CALL RAW16TOSPI(LUNMRC,LUNSPI,NSAM,NPIX8,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 NFLIP = 0 IF (FLIP) NFLIP = -1 !write(6,*) ' copymrc.f isswabt,flip: ', isswabt,flip CALL RAW32TOSPI(LUNMRC,LUNSPI,NSAM,NPIX8, & 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