C ++******************************************************************** C C COPYCCP4 MODIFIED FROM COPYMRC FEB 02 ArDean Leith C ISSWAB ADDED JUL 02 ArDean Leith C FLIP QUESTION MAR 03 ArDean Leith C BAD IRECCCP4 & FLIP SEP 03 ArDean Leith C SCALING JAN 05 ArDean Leith C I*8 SEP 08 ArDean Leith C NPIX8 DEC 08 ArDean Leith C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2008 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 COPYCCP4(LUNSPI,LUNCCP4,NSAM,NROW,NSLICE) C C PURPOSE: CONVERTS SPIDER IMAGES TO OR FROM CCP4 FORMAT C C NOTES: DATA IN CCP4 FILE: 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 COPYCCP4(LUNSPI,LUNCCP4,NSAM,NROW,NSLICE) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' COMMON /IOERR/ IERR COMMON /IOBUF/ BUFIN(NBUFSIZ) INTEGER * 8 :: NPIX8,NEED8,IGOT8,NT8 INTEGER * 1 :: I1BUF COMMON BUF(NBUFSIZ),FIXLENBUF(256),I1BUF(1024) CHARACTER(LEN=MAXNAM) :: FILNAM,CCP4FILE CHARACTER(LEN=1) :: NULL,ANS LOGICAL :: FLIP,ISSWABT,ISSWAB INTEGER * 2 :: I2VAL REAL *4 :: R4VALIN,R4VALOUT INTEGER *1 :: I1VALIN(4),I1VALOUT(4) EQUIVALENCE (R4VALIN,I1VALIN),(R4VALOUT,I1VALOUT) NULL = CHAR(0) IERR = 0 C FIND IF CURRENTLY SWAPPING BYTES ISSWABT = ISSWAB(99) IF (FCHAR(4:5) .EQ. 'TO') GOTO 1000 C COPY FROM CCP4 TO SPIDER FILE FORMAT --------------- FROM CCP4 C OPEN CCP4 FILE AS DIRECT ACCESS, UNFORMATTED, RECL=1024 BYTES LENOPENB = 1024 LENOPENF = 1024 / 4 CALL OPAUXFILE(.TRUE.,CCP4FILE,DATEXC,LUNCCP4,LENOPENB,'O', & 'CCP4 INPUT',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN C READ CCP4 HEADER CALL REDLIN(LUNCCP4,FIXLENBUF,LENOPENF,1) C PARSE CCP4 HEADER CALL GETHEDCCP4(FIXLENBUF,NSAM,NROW,NSLICE,MODE,FMIN,FMAX, & AV,RMS,NSYMBT,ISSWABT,FLIP,MACHST,IRTFLG) IF (IRTFLG .EQ. 2) THEN C NOT CURRENT CCP4 FORMAT CALL ERRT(101,'NOT CCP4 FORMAT, TRY OLD MRC FORMAT',NE) GOTO 9999 ENDIF C OPEN SPIDER OUTPUT FILE IFORM = 1 IF (NSLICE .GT. 1) IFORM = 3 MAXIM = 0 CALL OPFILEC(0,.TRUE.,FILNAM,LUNSPI,'U',IFORM,NSAM,NROW,NSLICE, & MAXIM,'SPIDER OUTPUT',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 C EXTRACT DATA FROM CCP4 FILE AFTER HEADER & PUT IN SPIDER FILE IOFFSET = 1024 + NSYMBT C NPIX8 = TOTAL NUMBER OF PIXELS IN CCP4 FILE NPIX8 = NSAM * NROW ! DO NOT SIMPLIFY, COMPILER WRONG NPIX8 = NPIX8 * NSLICE C CHANGE MODE: 0,1,2 TO MODEA: 8,16,32 MODEA = (2**(MODE + 1)) * 4 C CLOSE CCP4 FILE CLOSE(LUNCCP4) C REOPEN CCP4 FILE AS NSAM*MODEA/8 BYTE, DIRECT ACCESS, UNFORMATTED LENOPEN = NSAM * (MODEA / 8) CALL OPAUXFILE(.FALSE.,CCP4FILE,NULL,LUNCCP4,LENOPEN,'O', & ' ',.TRUE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL RDPRMC(ANS,NCHAR,.TRUE.,'FLIP BYTE ORDERING? (Y/N)', & NULL,IRT) IF (ANS .EQ. 'Y') FLIP = .NOT. FLIP c write(6,*)' modea,lenop,NPIX8:', c & modea,lenopen,NPIX8,nsam,nrow,nslice IF (MODEA .EQ. 8) THEN C 8 BIT INTEGER CCP4 INPUT FILE CALL RAW8TOSPI(LUNCCP4,LUNSPI,NSAM,NPIX8,IOFFSET,.TRUE., & LENOPEN,BUF,IRTFLG) ELSEIF (MODEA .EQ. 16) THEN C 16 BIT INTEGER CCP4 FILE (HEADER LENGTH DIVISABLE BY TWO) IF (IRTFLG .NE. 0) GOTO 9999 FLIP = .NOT. FLIP CALL RAW16TOSPI(LUNCCP4,LUNSPI,NSAM,NPIX8,IOFFSET,FLIP, & .FALSE.,LENOPEN,BUF,IRTFLG) ELSEIF (MODEA .EQ. 32) THEN C 32 BIT FOATING POINT CCP4 INPUT FILE IOFFSET = IOFFSET / 4 IRECCCP = 0 IRECSPI = 0 ILOCSPI = 0 ILOCCCP = NSAM + 1 IGOT8 = 0 C NEED8 IS TOTAL NUMBER OF BYTES TO BE READ INCLUDING HEADER NEED8 = NPIX8 + IOFFSET DO WHILE (IGOT8 .LT. NEED8) ILOCCCP = ILOCCCP + 1 IF (ILOCCCP .GT. NSAM) THEN C NEED TO READ NEW RECORD FROM INPUT NVAL = NSAM NT8 = NEED8 - IGOT8 IF (NT8 .LT. NSAM) NVAL = NT8 IRECCCP = IRECCCP + 1 CALL REDLIN(LUNCCP4,FIXLENBUF,NVAL,IRECCCP) c if(IRECCCP .le. 10)write(6,998)IRECCCP,nval,FIXLENBUF(nval) 998 format(' irec,nval,: ',2i10,' ; ',1pg13.7) ILOCCCP = 1 ENDIF C IGOT8 POINTS TO CURRENT WORD IN INPUT FILE IGOT8 = IGOT8 + 1 IF (IGOT8 .GT. IOFFSET) THEN C WANT THIS VALUE FOR AN OUTPUT PIXEL ILOCSPI = ILOCSPI + 1 IF (FLIP) THEN C INVERT BYTE ORDER R4VALIN = FIXLENBUF(ILOCCCP) I1VALOUT(1) = I1VALIN(4) I1VALOUT(2) = I1VALIN(3) I1VALOUT(3) = I1VALIN(2) I1VALOUT(4) = I1VALIN(1) BUF(ILOCSPI) = R4VALOUT ELSE C NO FLIP BUF(ILOCSPI) = FIXLENBUF(ILOCCCP) ENDIF ENDIF IF (ILOCSPI .GE. NSAM) THEN C PUT OUT COMPLETED RECORD IRECSPI = IRECSPI + 1 CALL WRTLIN(LUNSPI,BUF,NSAM,IRECSPI) ILOCSPI = 0 c itmp = mod(irecspi,nrow) c if (itmp .eq. 0) write(6,999) irecspi,buf(nsam) 999 format(i10,' ; ',1pg13.7) ENDIF ENDDO ELSE CALL ERRT(102,'CAN NOT COPY CCP4 MODE',MODE) ENDIF GOTO 9999 C COPY FROM SPIDER TO CCP4 FILE FORMAT ----------------- TO CCP4 1000 CONTINUE C OPEN NEW CCP4 FILE FOR DIRECT ACCESS, RECORD LENGTH 1024 BYTES LENOPENB = 1024 LENOPENF = LENOPENB / 4 CALL OPAUXFILE(.TRUE.,CCP4FILE,DATEXC,LUNCCP4,LENOPENB,'U', & 'CCP4 OUTPUT',.TRUE.,IRTFLG) IVAL = 8 CALL RDPRI1S(IVAL,NOT_USED, & 'ENTER DATA LENGTH FOR CCP4 FILE (8 OR 32 BITS)',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 MODE = 2 IF (IVAL .EQ. 8) MODE = 0 C CREATE A NEW HEADER FOR THE CCP4 FILE FMINT = FMIN FMAXT = FMAX FAVT = AV FSIGT = SIG IF (MODE .EQ. 0) THEN FN = (255.0 - 0.0) / (FMAXT - FMINT) FNCON = 0.0 - FN * FMINT FMINT = 0.0 FMAXT = 255.0 I2VAL = FMINT * FN + FNCON FAVT = I2VAL C FSIGT IS NOT RIGHT!!!! FSIGT = -1.0 ENDIF C TRY TO GET SCALE VALUE (MAY NOT BE USED) CALL GETLAB(LUNSPI,NSAM,UNUSED,21,1,SCALE,IRTFLG) C CREATE HEADER. (NOTE: FMIN, FMAX, AV ARE SAME AS SPIDER IMAGE) CALL SETHEDCCP4(FIXLENBUF, NSAM, NROW, NSLICE, & FMINT,FMAXT,FAVT,FSIGT,SCALE,MODE,ISSWABT,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 C WRITE HEADER OF 1024 BYTES (256 FLOATS) TO CCP4 FILE CALL WRTLIN(LUNCCP4,FIXLENBUF,LENOPENF,1) C SET STARTING RECORD FOR CCP4 DATA IRECOUT = 1 ILOCOUT = 0 IF (MODE .EQ. 2) THEN DO IRECIN = 1,NROW * NSLICE C READ EACH ROW OF SPIDER INPUT FILE CALL REDLIN(LUNSPI,BUFIN,NSAM,IRECIN) C PUT ROW OUT TO CCP4 FILE DO ILOCIN=1,NSAM ILOCOUT = ILOCOUT + 1 FIXLENBUF(ILOCOUT) = BUFIN(ILOCIN) IF (ILOCOUT .GE. LENOPENF) THEN C PUT OUT COMPLETED RECORD IRECOUT = IRECOUT + 1 CALL WRTLIN(LUNCCP4,FIXLENBUF,LENOPENF,IRECOUT) ILOCOUT = 0 ENDIF ENDDO ENDDO IF (ILOCOUT .GT. 0) THEN C PUT OUT REMAINING RECORD IRECOUT = IRECOUT + 1 CALL WRTLIN(LUNCCP4,FIXLENBUF,ILOCOUT,IRECOUT) ENDIF ELSEIF (MODE .EQ. 0) THEN C COPY FROM SPIDER TO CCP4 8 BIT FILE FORMAT DO IRECIN = 1,NROW * NSLICE C READ EACH ROW OF SPIDER INPUT FILE CALL REDLIN(LUNSPI,BUFIN,NSAM,IRECIN) C PUT ROW OUT TO CCP4 FILE DO ILOCIN=1,NSAM ILOCOUT = ILOCOUT + 1 I2VAL = BUFIN(ILOCIN) * FN + FNCON I1BUF(ILOCOUT) = I2VAL IF (ILOCOUT .GE. LENOPENB) THEN C PUT OUT COMPLETED RECORD IRECOUT = IRECOUT + 1 CALL WRTLIN8(LUNCCP4,I1BUF,LENOPENB,IRECOUT) IF (IERR .NE. 0) THEN CALL ERRT(102,'WRITING RECORD',IRECIN) GOTO 9999 ENDIF ILOCOUT = 0 ENDIF ENDDO ENDDO IF (ILOCOUT .GT. 0) THEN C PUT OUT REMAINING RECORD IRECOUT = IRECOUT + 1 CALL WRTLIN8(LUNCCP4,I1BUF,ILOCOUT,IRECOUT) ENDIF ELSE CALL ERRT(102,'CAN NOT CREATE CCP4 MODE',MODE) GOTO 9999 ENDIF IF (IERR .NE. 0) THEN CALL ERRT(102,'WRITING RECORD',IRECIN) GOTO 9999 ENDIF 9999 CLOSE(LUNSPI) CLOSE(LUNCCP4) RETURN END C -------------- ISSWAB ---------------------------------------- LOGICAL FUNCTION ISSWAB(LUN) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' INTEGER,DIMENSION(3) :: IVAL CHARACTER(LEN=12) :: CVAL,CVALIN EQUIVALENCE(IVAL,CVAL) CHARACTER(LEN=1) :: NULL CHARACTER(LEN=MAXNAM) :: FILNAM LOGICAL :: VERBOSE_SAVE NULL = CHAR(0) C DO NOT ECHO FILE OPENING VERBOSE_SAVE = VERBOSE VERBOSE = .FALSE. FILNAM = 'TMP_JNK_SCRATCH' CALL OPAUXFILE(.FALSE.,FILNAM,NULL,LUN,12,'U',' ',.TRUE.,IRTFLG) CVAL(1:1) = CHAR(0) CVAL(2:2) = CHAR(0) CVAL(3:3) = CHAR(0) CVAL(4:4) = CHAR(4) CVAL(5:5) = CHAR(48) CVAL(6:6) = CHAR(48) CVAL(7:7) = CHAR(49) CVAL(8:8) = CHAR(50) CVAL(9:9) = CHAR(0) CVAL(10:10) = CHAR(0) CVAL(11:11) = CHAR(0) CVAL(12:12) = CHAR(4) CALL WRTLIN(LUN,IVAL,3,1) CLOSE(LUN) CALL OPAUXFILE(.FALSE.,FILNAM,NULL,LUN,0,'O',' ',.TRUE.,IRTFLG) READ(LUN,*) CVALIN CLOSE(LUN,STATUS='DELETE') c WRITE(NOUT,*) 'CVALIN: ',CVALIN,' == ',CVAL ISSWAB = (CVALIN(8:8) .NE. CVAL(8:8)) c IF (ISSWAB) THEN c WRITE(NOUT,*) 'NON-NATIVE BYTE ORDER ' c ELSE c WRITE(NOUT,*) 'NATIVE BYTE ORDER' c ENDIF VERBOSE = VERBOSE_SAVE END