C++********************************************************************* C C OPENSTK.F -- CREATED DEC. 96 -- ArDean Leith C USED LUNHDR FEB. 99 -- ArDean Leith C INDEXED STACKS JAN. 03 -- ArDean Leith C HEADER COPY FEB. 03 -- ArDean Leith C OPENFIL PARAMETERS APR. 04 -- ArDean Leith C BAD IRTFLG RETURN AUG. 04 -- ArDean Leith C ERROR MSG DEC. 10 -- ArDean Leith C MPI ERROR MSG MAR. 11 -- ArDean Leith C ********************************************************************** C=* * C=* This file is part of: SPIDER - Modular Image Processing System. * C=* SPIDER System Authors: Joachim Frank & ArDean Leith * C=* Copyright 1985-2011 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 OPENSTK(LUNT,FILNAM,LUN,NSAM,NROW,NSLICE,NSTACK,ITYPE,DISP,IRTFLG) C C PURPOSE: TO OPEN A NEW OR EXISTING STACK FILE. NOT FOR INLINE C STACKS C C PARAMETERS: C LUNT UNIT TO COPY HEADER VALUES FROM (SENT) C FILNAM CHARACTER ARRAY, CONTAINING FILE NAME (SENT) C LUN LOGICAL UNIT NUMBER FOR FILNAM. (SENT) C NSAM,NROW DIMENSIONS OF FILE (SENT/RET.) C NSLICE NUMBER OF PLANES (SENT/RET.) C ITYPE IFORM (SENT/RET.) C NSTACK STACK INDICATOR (SENT/RET.) C ON INPUT: C >0 : REGULAR STACK FILE (IF NEW) C <0 : INDEXED STACK FILE (IF NEW) C ON OUTPUT: C -2 : NOT STACK = ERROR C -1 : STACKED IMAGE C 0 : REGULAR BARE STACK, CONTAINS NO IMAGE(S) C >0 : INDEXED BARE STACK, VALUE IS MAX. IMAGE C 5 : NOT SPIDER FILE? C C DISP FILE DISPOSITION, SEE OPFIL FOR VALUES (SENT) C IRTFLG ERROR RETURN FLAG. (RET.) C IRTFLG = 0 NORMAL RETURN C C CALL TREE: SEE OPFIL C C23456789 123456789 123456789 123456789 123456789 123456789 123456789 12 C--********************************************************************* SUBROUTINE OPENSTK(LUNT,FILNAM,LUN,NSAM,NROW,NSLICE, & NSTACK,ITYPE,DISP,IRTFLG) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' CHARACTER (LEN=*) :: FILNAM,DISP CHARACTER (LEN=MAXNAM) :: FILNOAT,FILNPE LOGICAL :: EX,ISDIGI,CALLERRTRED,INDXD #ifdef USE_MPI include 'mpif.h' #endif CALL SET_MPI(ICOMM,MYPID,MPIERR) ! SETS ICOMM AND MYPID C SHOULD NOT STOP IF DISP == 'Z' AND REDHED FAILS CALLERRTRED = (DISP(1:1) .NE. 'Z') C SET ERROR RETURN IRTFLG = 1 NSTACKIN = NSTACK ILOCAT = INDEX(FILNAM,'@') IF (ISDIGI(FILNAM(ILOCAT + 1:ILOCAT + 1))) THEN C FIND IMAGE NUMBER WITHIN STACK FILE CALL GETFILENUM(FILNAM(ILOCAT:),IMGNUM,NDIGITS,.TRUE.,IER) IF (IER .NE. 0) RETURN IF (IMGNUM .LE. 0) THEN CALL ERRT(101,'STACKS START WITH IMAGE: 1',NE) RETURN ENDIF ELSE C SET IMGNUM FOR BARESTACK IMGNUM = 0 ENDIF C GET FILENAME WITHOUT @ AND DATEXC FILNOAT = FILNAM(1:ILOCAT-1) // CHAR(0) C CREATE STACK FILE NAME WITHOUT '@' BUT WITH EXTENSION CALL FILNAMANDEXT(FILNOAT,DATEXC,FILNPE,NLET,.TRUE.,IRTFLGT) IF (IRTFLGT .NE.0) RETURN C SEE IF STACK FILE ALREADY EXISTS NOW #ifdef USE_MPI INQUIRE(FILE=FILNPE,IOSTAT=IER,EXIST=EX) CALL MPI_BCAST(IER,1,MPI_INTEGER,0,ICOMM,MPIERR) IF (MPIERR .NE. 0) THEN WRITE(0,*) ' OPENSTK: FAILED TO BCAST IER' STOP ENDIF CALL MPI_BCAST(EX,1,MPI_LOGICAL,0,ICOMM,MPIERR) IF (MPIERR .NE. 0) THEN WRITE(0,*) ' OPENSTK: FAILED TO BCAST EX' STOP ENDIF #else INQUIRE(FILE=FILNPE,IOSTAT=IER,EXIST=EX) #endif IF (IER .NE. 0) THEN WRITE(NOUT,*) '*** FILE INQUIRY ERROR: ',FILNPE(1:NLET) CALL ERRT(100,'OPENSTK',NE) RETURN ENDIF IF (DISP(1:1) .EQ. 'U' .OR. DISP(1:1) .EQ. 'N') THEN C WANT TO MAKE A NEW STACK OR NEW IMAGE WITHIN EXISTING STACK C -------------------------------- NEW -------------------------------- IF (.NOT. EX .OR. IMGNUM .EQ. 0) THEN C STACK FILE DOES NOT EXIST YET, OR MUST BE REPLACED IF (NSTACKIN .LT. 0) THEN C FLAG FOR INDEXED STACK CALL RDPRI1S(NSTACK,NOT_USED, & 'HIGHEST IMAGE/VOLUME NUMBER ALLOWED IN STACK',IRTFLGT) IF (IRTFLGT .NE. 0) RETURN IF (NSTACK .LT. 1) THEN CALL ERRT(101,'HIGHEST NUMBER MUST BE > 0',NE) RETURN ENDIF NSTACK = -NSTACK ELSE C REGULAR NEW STACK NSTACK = 2 ENDIF C CREATE NEW STACK FILE, OPENFIL WILL RETURN NSTACK = 0 CALL OPENFIL(0,FILNOAT,LUN, NSAM,NROW,NSLICE,NSTACK, & ITYPE,DISP,.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (NSTACKIN .LT. 0) THEN C CLEAR STACK INDEX IN NEW FILE CALL LUNCLRINDX(LUN,NSAM,IRTFLGT) ENDIF IF (IMGNUM .LE. 0) THEN C ONLY WANT TO OPEN NEW BARE STACK IRTFLG = 0 RETURN ENDIF ELSE C OPEN EXISTING STACK FILE TO APPEND A NEW STACKED IMAGE ITYPEIN = ITYPE CALL OPENFIL(0,FILNOAT,LUN, NSAMF,NROWF,NSLICEF,NSTACK, & ITYPE,'O',.FALSE.,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN C OPENFIL WILL RETURN NUMBER OF IMAGES IN STACK, OR -1 C IF THIS IS A SPECIFIC IMAGE WITHIN THE STACK, -2 IS C FOR NON-STACK IMAGE. IF (NSTACK .LE. -2) THEN C EXISTING FILE IS NOT A STACK CALL ERRT(101,'EXISTING FILE IS NOT A STACK',NE) RETURN ELSEIF (NSAMF .NE. NSAM .OR. NROWF .NE. NROW .OR. & NSLICEF .NE. NSLICE) THEN C EXISTING FILE HAS DIFFERING DIMENSIONS CALL ERRT(101,'IMAGE DIMENSIONS NOT SAME AS STACK',NE) RETURN ELSEIF (ITYPEIN .NE. ITYPE) THEN C EXISTING STACK FILE FORMAT NOT SAME AS IMAGE FORMAT CALL ERRT(101, & 'IMAGES IN STACK MUST HAVE SAME FILE FORMAT',NE) RETURN ENDIF ENDIF C RECOVER MAXIM & ISTACK FROM OVERALL HEADER CALL LUNGETSTK(LUN,ISTACK,MAXIM,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN IF (IMGNUM .GT. MAXIM) THEN C UPDATE OVERALL HEADER WITH MAXIMUM IMAGE NUMBER IN USE NOW CALL LUNSETMAXIM(LUN,IMGNUM,IRTFLGT) CALL LUNSETMAXALL(LUN,IMGNUM,IRTFLGT) ENDIF IF (ISTACK .LT. 0) THEN C NEW INDEXED STACKED FILE, UPDATE INDX LOCATION CALL LUNWRTINDX(LUN,IMGNUM,NSAM,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN ENDIF IF (IMGNUM .GT. MAXIM .OR. ISTACK .LT. 0) THEN C SAVE OVERALL HEADER NOW TO PRESERVE MAXIM & LASTINDX CALL LUNWRTHED(LUN,NSAM,0,IRTFLGT) ENDIF C CREATE HEADER FOR NEW STACKED IMAGE, C KEEPS STATIC ISBARE SETTING, MAXIM, AND STKALL SETTING ISTACK = 0 CALL LUNSETHDR(LUNT,LUN,NSAM,NROW,NSLICE, & ITYPE,ISTACK,IRTFLGT) C SET IMGNUM FOR THIS CURRENT IMAGE CALL LUNSETINUSE(LUN,IMGNUM,IRTFLGT) C PLACE NEW STACKED IMAGE HEADER INTO PROPER STACK LOCATION CALL LUNWRTHED(LUN,NSAM,IMGNUM,IRTFLGT) C SET PROPER OFFSET INTO LUNSTK FOR IMGNUM CALL LUNSETIMGOFF(LUN,IMGNUM,NSAM,IRTFLGT) C RETURNS NSTACK = -1 TO SIGNIFY THIS IS STACKED IMAGE NSTACK = -1 C -------------------------------- OLD -------------------------------- ELSEIF (DISP(1:1) .EQ. 'O' .OR. DISP(1:1) .EQ. 'K' .OR. & DISP(1:1) .EQ. 'Z' .OR. & DISP(1:1) .EQ. 'E' .OR. DISP(1:1) .EQ. 'M') THEN C WANT AN EXISTING IMAGE FROM EXISTING STACK OR AN C EXISTING BARE STACK HEADER IF (.NOT. EX) THEN C STACK FILE DOES NOT EXIST YET, ERROR NLETE = lnblnkn(FILNOAT) WRITE(NOUT,*)'*** STACK FILE NOT FOUND: ',FILNOAT(:NLETE) C FOR DISP=Z, DO NOT STOP THE BATCH JOB BY CALLING ERRT IF (DISP .NE. 'Z') CALL ERRT(100,'OPENSTK',NE) RETURN ENDIF C OPEN EXISTING OVERALL STACK FILE, RETURNS MAXIM IN NSTACK CALL OPENFIL(0,FILNOAT,LUN, NSAM,NROW,NSLICE,NSTACK, & ITYPE,'O',.FALSE.,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN IF (NSTACK .LE. -2) THEN C EXISTING FILE IS NOT A STACK FILE CALL ERRT(101,'EXISTING FILE IS NOT A STACK',NE) RETURN ELSEIF (IMGNUM .LE. 0) THEN C JUST WANT BARE STACK, RETURN NSTACK = MAX IMAGE IN STACK IRTFLG = 0 RETURN ELSEIF (IMGNUM .GT. NSTACK) THEN C STOP IF REQUESTED IMAGE NOT IN STACK IF (DISP .NE. 'Z') THEN CALL ERRT(102,'THIS IMAGE NOT USED IN STACK',IMGNUM) ENDIF RETURN ENDIF C SET OFFSET INTO LUNSTK FOR THIS STACKED IMAGE CALL LUNSETIMGOFF(LUN,IMGNUM,NSAM,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN C GET SPECIFIED IMAGE HEADER FROM STACK FILE LOCATION CALL LUNREDHED(LUN,NSAM,IMGNUM,CALLERRTRED,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN C RECOVER IMAGE PARAMETERS FROM SPECIFIC IMAGE HEADER C GET IMUSED FOR THIS CURRENT IMAGE CALL LUNGETINUSE(LUN,IMUSED,IRTFLGT) IF (IMUSED .NE. IMGNUM) THEN C NO EXISTING IMAGE WITHIN STACK?? IF (IMUSED .EQ. 0) THEN C SOME VERY OLD STACKS DID NOT HAVE IMGNUM IN THEM CALL LUNGET25(LUN,IVAL,IRTFLGT) IF (IVAL .NE. 1) THEN IF (DISP .NE. 'Z') THEN CALL ERRT(102,'STACK LACKS IMAGE',IMGNUM) ENDIF RETURN ENDIF IMUSED = IMGNUM CALL LUNSETINUSE(LUN,IMUSED,IRTFLGT) ENDIF ENDIF C RETURN NSTACK = -1 (FOR STACKED IMAGE) NSTACK = -1 ELSE CALL ERRT(101,'PGM. ERROR: UNKNOWN DISP IN OPENSTK',NE) RETURN ENDIF C ------------------------------- BOTH -------------------------------- C WRITE OUT FILE OPENING INFO CALL LUNSAYINFO(LUN,IRTFLGT) C SET COMMON BLOCK VARIABLES CALL LUNSETCOMMON(LUN,IRTFLGT) C SET FLAG FOR NORMAL RETURN IRTFLG = 0 RETURN END