C++********************************************************************* C C GALI.F DYNAMIC MEMORY ALLOCATION SEPT 2000 BIMAL RATH C REPLACED 'INCORE' SEPT 2001 ARDEAN LEITH C OPFILEC FEB 2003 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 GALI C CALLS: GALI_P C ALROSI_Q C ALROSF_Q C RTQS_Q C CROSRNG_Q C SHFI_Q C BLOB_Q C FINDMX_Q C ALRQ_Q C ALPRBS_Q C FOURING_Q C RTQ_Q C CENT_Q C OUTIM_Q C FMRS_1 C FMRS_1D C QUADRI_Q C C IMAGE_PROCESSING_ROUTINE C C23456789012345678901234567890123456789012345678901234567890123456789012 C C--********************************************************************* SUBROUTINE GALI INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' INTEGER, ALLOCATABLE, DIMENSION(:) :: ILIST INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NUMR REAL, ALLOCATABLE, DIMENSION(:,:) :: BLOB CHARACTER*80 FINPAT,FINPIC,DOCFIL,OUTIMA,OUTDOC COMMON /FISPEC/ FINPAT,FINPIC,DOCFIL,OUTIMA,OUTDOC, & NLET,NLETI,NLIMA,NLDOC COMMON /MXR/ MAXRIN CHARACTER*1 NULL,MODE LOGICAL USEBLOB DATA INPIC/78/ NULL = CHAR(0) NILMAX = NIMAX ALLOCATE(ILIST(NILMAX), STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'AP SR, ILIST',IER) RETURN ENDIF C ASK FOR DATA FILE LIST CALL FILELIST(.TRUE.,INPIC,FINPAT,NLET,ILIST,NILMAX,NIMA, & 'ENTER TEMPLATE FOR 2-D IMAGE',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 IF (NIMA .LE. 0) THEN CALL ERRT(101,'NO IMAGES',IER) GOTO 9999 ENDIF WRITE(NOUT,2001) NIMA 2001 FORMAT(' NUMBER OF IMAGES: ',I6) C OPEN ONE FILE TO GET SIZE CALL FILGET(FINPAT,FINPIC,NLET,ILIST(1),INTFLG) MAXIM = 0 CALL OPFILEC(0,.FALSE.,FINPIC,INPIC,'O',IFORM,NSAM,NROW,NSLICE, & MAXIM,' ',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CLOSE(INPIC) C FOURIER SIZE LSD = NSAM + 2 - MOD(NSAM,2) CALL RDPRI1S(NSI,NOT_USED,'EXPECTED SIZE OF THE OBJECT', & IRTFLG) IF (NSI .GE. NSAM) THEN WRITE(NOUT,*)' OBJECT SIZE CANNOT BE LARGER THAN WINDOW SIZE' NSI = NSAM - 2 WRITE(NOUT,*) ' OBJECT SIZE SET TO: ',NSI ENDIF NSI = MAX0(1,(NSAM-NSI)/2) CALL RDPRMI(MR,NR,NOT_USED,'FIRST AND LAST RING RADIUS') IF (MR.LE.0 .OR. NR.GE.MIN0((NSAM/2),(NROW/2)))THEN CALL ERRT(31,'AP SR',NE) GOTO 9999 ENDIF C CALL RDPRMI(ISKIP,NDUMP,NOT_USED,'SKIP') C ISKIP = MAX0(1,ISKIP) IF (NR .GT. NSAM/2-1) THEN NR = NSAM/2-1 WRITE(NOUT,*) ' LAST RING RADIUS LIMITED TO: ',NR ENDIF MR = MAX0(1,MIN0(NR,MR)) ISKIP = 1 MODE = 'F' C FIND TOTAL NUMBER OF RINGS NRING = 0 DO I=MR,NR,ISKIP NRING = NRING + 1 ENDDO ALLOCATE (NUMR(3,NRING), STAT=IRTFLG) IF (IRTFLG.NE.0) THEN CALL ERRT(46,'AP SR, NUMR',IER) GOTO 9999 ENDIF NRING = 0 DO I=MR,NR,ISKIP NRING = NRING + 1 NUMR(1,NRING) = I ENDDO CALL ALPRBS_Q(NUMR,NRING,LCIRC,MODE) MAXRIN = NUMR(3,NRING)-2 C CHECK WHETHER USER HAS OWN REFERENCE FILE TO CENTER THE AVERAGE. C DISP = 'Z' WILL NOT CALL ERRT IN OPFIL IF NOT EXISTING MAXIM = 0 CALL OPFILEC(0,.TRUE.,OUTIMA,INPIC,'Z',IFORM,NSAM,NROW,NSLICE, & MAXIM,'IMAGE TO BE USED TO CENTER THE AVERAGE',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) THEN WRITE(NOUT,*) ' NO IMAGE GIVEN, DEFAULT PROCEDURE USED' USEBLOB = .TRUE. ELSE USEBLOB = .FALSE. ENDIF C TEMPLATES FOR OUTPUT FILES CALL FILERD(OUTIMA,NLIMA,NULL, & 'ENTER TEMPLATE FOR OUTPUT',IRTFLG) CALL FILERD(OUTDOC,NLDOC,NULL, & 'ENTER TEMPLATE FOR OUTPUT DOC.',IRTFLG) C CALL RDPRMI(JACUP,NDUMP,NOT_USED, C & 'PRECISION OF PEAK LOCATION (0..100)') C JACUP=MAX0(0,MIN0(100,JACUP)) JACUP = 0 ALLOCATE(BLOB(LSD,NROW),STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'AP SR, BLOB',IER) GOTO 9999 ENDIF IF (.NOT.USEBLOB) THEN CALL READV(INPIC,BLOB,LSD,NROW,NSAM,NROW,NSLICE) CLOSE(INPIC) ENDIF CALL GALI_P(LSD,NSAM,NROW,NSI,ILIST,NIMA,MODE,JACUP, & LCIRC,NUMR,NRING,MAXRIN,BLOB,USEBLOB,NR,NOUT) WRITE (NOUT,2600) 2600 FORMAT (/,' ',72('-'),//, & ' ',' ALIGNMENT, END OF COMPUTATION',//, & ' ',72('-')/) 9999 IF (ALLOCATED(BLOB)) DEALLOCATE(BLOB) IF (ALLOCATED(NUMR)) DEALLOCATE(NUMR) IF (ALLOCATED(ILIST)) DEALLOCATE(ILIST) END