C++********************************************************************* C C APMASTER.F CAN OUTPUT TO REGISTERS NOW MAY 01 ARDEAN LEITH C CAN GET ANGLES FROM HEADER JUN 01 ARDEAN LEITH C NORMASS -> NORMAS OCT 01 ARDEAN LEITH C SAVDN1 + SAVD BUG JAN 02 ArDean Leith C PROMPTS JAN 02 ARDEAN LEITH C UNSAV LOOP IMPROVED SEP 02 ARDEAN LEITH C ADDED ANG. DIFFERENCE OCT 02 ARDEAN LEITH C OPFILEC FEB 03 ARDEAN LEITH C MERGED WITH DSFR & DSGRS AUG 03 ARDEAN LEITH C MERGED WITH DSFS AUG 03 ARDEAN LEITH C MERGED WITH MRQLI1 SEP 03 ARDEAN LEITH C HEADER OUTPUT CHANGED OCT 03 ARDEAN LEITH C MPI OUTPUT CHANGED FEB 04 Chao Yang C 'AP SH' FEB 04 ARDEAN LEITH C 'DOC FILE HEADERS' APR 04 ARDEAN LEITH C OR REF FILE JUN 04 ARDEAN LEITH C PSI,THE,PHI JUN 04 ARDEAN LEITH C REF_RINGS AUTO CREATION JAN 05 ARDEAN LEITH C ANG DIFF. THRESHOLD FEB 05 ARDEAN LEITH C 'OR' HAD OUTPUT FILE BUG AUG 05 ARDEAN LEITH C 'AP RQN' MIRRORED BUG DEC 05 ARDEAN LEITH C 'AP SCC' INCORPORATED FEB 08 ARDEAN LEITH C APRINGS_INIT_PLANS APR 08 ARDEAN LEITH C OBSOLETE OPERATION MSG. MAY 08 ARDEAN LEITH C 'OR NQ, OR MQ --> OR SH' JUN 08 ARDEAN LEITH C APRINGS RAYS JUN 08 ARDEAN LEITH C FFTW3_KILLPLANS JAN 09 ARDEAN LEITH C 'AP SH' CIRCREF ALLOC MSG. AUG 09 ARDEAN LEITH C MOVED 'AP SCC' OUT AUG 09 ARDEAN LEITH C C ********************************************************************** C=* This file is part of: * C=* SPIDER - Modular Image Processing System. Author: J. FRANK * C=* Copyright 1985-2009 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=* * 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 APMASTER(MODE,CTYPE) C C MASTER IO AND INITIALIZATION ROUTINE FOR MOST 'AP ..' OPERATIONS C C23456789 123456789 123456789 123456789 123456789 123456789 123456789 12 C--********************************************************************* SUBROUTINE APMASTER(MODE,CTYPE) INCLUDE 'CMLIMIT.INC' INCLUDE 'CMBLOCK.INC' INTEGER, ALLOCATABLE, DIMENSION(:) :: IMGLST INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NUMR REAL, ALLOCATABLE, DIMENSION(:,:) :: CIRCREF CHARACTER (LEN=MAXNAM) :: ASK,SCRFILE,FILNAM,REFANGDOC CHARACTER (LEN=MAXNAM) :: REFPAT,EXPPAT,EXPANGDOC,OUTANG CHARACTER(LEN=1) :: MODE,NULL,ANS,YN CHARACTER(LEN=210) :: COMMEN CHARACTER(LEN=*) :: CTYPE LOGICAL :: CIRCREF_IN_CORE,CKMIRROR LOGICAL :: WINDOW,NEWFILE REAL :: VALUES(4) INTEGER, PARAMETER :: NPLANS = 14 #ifndef SP_32 INTEGER *8 :: IASK8,IOK INTEGER *8 :: FFTW_PLANS(NPLANS) #else INTEGER *4 :: IASK8,IOK INTEGER *4 :: FFTW_PLANS(NPLANS) #endif CALL SET_MPI(ICOMM,MYPID,MPIERR) ! SETS ICOMM AND MYPID DATA LUNREF,LUNEXP,LUNRING/50,51,52/ DATA INPIC,INANG,NDOC,NSCF/77,78,55,50/ !USED IN CALLED ROUTINE NULL = CHAR(0) NILMAX = NIMAX IF (CTYPE(1:2) .EQ. 'MQ' .OR. & CTYPE(1:2) .EQ. 'NQ' .OR. & CTYPE(1:2) .EQ. 'RQ') THEN IF (MYPID .LE. 0) WRITE(NOUT,901) 901 FORMAT( & ' OBSOLETE OPERATION, NEXT TIME PLEASE USE: ',/) ELSEIF (CTYPE(1:2) .EQ. 'MD' .OR. & CTYPE(1:2) .EQ. 'RD' .OR. & CTYPE(1:2) .EQ. 'RN') THEN IF (MYPID .LE. 0) WRITE(NOUT,902) 902 FORMAT( & ' OBSOLETE OPERATION, NEXT TIME PLEASE USE: ',/) ELSEIF (CTYPE(1:3) .EQ. 'ORN' .OR. & CTYPE(1:2) .EQ. 'ORM') THEN IF (MYPID .LE. 0) WRITE(NOUT,903) 903 FORMAT( & ' OBSOLETE OPERATION, NEXT TIME PLEASE USE: ',/) ENDIF IF (CTYPE(1:2) .EQ. 'OR') THEN MAXIM = 0 CALL OPFILEC(0,.TRUE.,REFPAT,LUNREF,'O',ITYPE,NSAM,NROW, & NSLICE,MAXIM,'REFERENCE',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) RETURN NUMREF = 1 INUMBR(1) = 0 ELSE C ASK FOR TEMPLATE AND NUMBERS FOR REFERENCE IMAGES CALL FILELIST(.TRUE.,LUNREF,REFPAT,NLET,INUMBR,NILMAX,NUMREF, & 'ENTER TEMPLATE FOR REFERENCE IMAGES',IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (MYPID .LE. 0) WRITE(NOUT,2001) NUMREF 2001 FORMAT(' Number of reference images: ',I7) ENDIF C NUMREF - TOTAL NUMBER OF REF. IMAGES IF (NUMREF .LE. 0) THEN CALL ERRT(101,'No reference images',IDUM) GOTO 9999 ENDIF C GET FIRST REFERENCE IMAGE TO DETERMINE DIMENSIONS IF (CTYPE(1:2) .EQ. 'OR') THEN FILNAM = REFPAT ELSE NLET = 0 CALL FILGET(REFPAT,FILNAM,NLET,INUMBR(1),INTFLG) ENDIF MAXIM = 0 CALL OPFILEC(0,.FALSE.,FILNAM,LUNREF,'O',IFORM,NSAM,NROW,NSLICE, & MAXIM,' ',.FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CLOSE(LUNREF) ISHRANGE = 0 ISTEP = 1 IF (CTYPE(1:2) .EQ. 'MQ' .OR. & CTYPE(1:2) .EQ. 'NQ' .OR. & CTYPE(1:2) .EQ. 'RQ' .OR. & CTYPE(1:2) .EQ. 'SH' .OR. & CTYPE(1:2) .EQ. 'OR') THEN CALL RDPRIS(ISHRANGE,ISTEP,NOT_USED, & 'TRANSLATION SEARCH RANGE, STEP SIZE',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 ISHRANGE = MAX(ISHRANGE,1) ISTEP = MAX(ISTEP,1) C CHECK SEARCH RANGE AND STEP SIZE. IF (ISHRANGE .GT. NSAM/2-2) THEN CALL ERRT(102,'SEARCH MUST BE LESS THAN',NSAM/2-2) GOTO 9999 ELSEIF (MOD(ISHRANGE,ISTEP) .NE. 0) THEN CALL ERRT(101,'SEARCH RANGE MUST BE DIVISIBLE BY',ISTEP) GOTO 9999 ENDIF ELSEIF ( CTYPE(1:3) .EQ. 'REF' ) THEN CALL RDPRI1S(ISHRANGE,NOT_USED, & 'TRANSLATION SEARCH RANGE (ZERO FOR NONE)' ,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 ENDIF IRAY = 1 MR = 5 NR = MIN(NSAM/2-1, NROW/2-1) IF (CTYPE(1:2) .EQ. 'MQ' .OR. & CTYPE(1:2) .EQ. 'NQ' .OR. & CTYPE(1:2) .EQ. 'RQ' .OR. & CTYPE(1:2) .EQ. 'OR') THEN ISKIP = 1 CALL RDPRIS(MR,NR,NOT_USED,'FIRST & LAST RING',IRTFLG) ELSE ISKIP = 0 VALUES(1) = MR VALUES(2) = NR VALUES(3) = ISKIP VALUES(4) = IRAY CALL RDPRA('FIRST, LAST RING, RING STEP & RAY STEP', & 4,0,.TRUE.,VALUES,NGOT,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (NGOT .GT. 0) THEN C COPY THE RETURNED VALUES IF (NGOT .GE. 1) MR = VALUES(1) IF (NGOT .GE. 2) NR = VALUES(2) IF (NGOT .GE. 3) ISKIP = VALUES(3) IF (NGOT .GE. 4) IRAY = VALUES(4) ENDIF IF ( CTYPE(1:2) .NE. 'SH' .AND. ISKIP .LE. 0) THEN ISKIP = 1 CALL RDPRI1S(ISKIP,NOT_USED,'RING STEP',IRTFLG) ENDIF ENDIF IF (IRTFLG .NE. 0) GOTO 9999 ISKIP = MAX(1,ISKIP) IF (IRAY .NE. 1 .AND. IRAY .NE. 2 .AND. & IRAY .NE. 4 .AND. IRAY .NE. 8) THEN CALL ERRT(101,'RAY STEP MUST BE 1,2,4, OR 8',NE) GOTO 9999 ENDIF NRAD = MIN(NSAM/2-1, NROW/2-1) IF (MR .LE. 0) THEN CALL ERRT(101,'FIRST RING MUST BE > 0',NE) GOTO 9999 ELSEIF (NR .LT. MR) THEN CALL ERRT(102,'LAST RING MUST BE > ',MR) GOTO 9999 ELSEIF (NR .GE. NRAD) THEN CALL ERRT(102,'LAST RING MUST BE < ',NRAD) GOTO 9999 ELSEIF (CTYPE(1:2) .EQ. 'MQ' .OR. & CTYPE(1:2) .EQ. 'RQ' .OR. & CTYPE(1:2) .EQ. 'RN' .OR. & CTYPE(1:2) .EQ. 'SH') THEN C CHECK SEARCH RANGE AND STEP SIZE TOGETHER IF ((ISHRANGE+NR) .GT. (NRAD-1)) THEN CALL ERRT(102,'LAST RING + TRANSLATION MUST BE <',NRAD) GOTO 9999 ENDIF ENDIF REFANGDOC = NULL IF ((CTYPE(1:2) .EQ. 'RN' .AND. CTYPE(3:3) .NE. 'S') .OR. & CTYPE(1:2) .EQ. 'RD' .OR. & CTYPE(1:3) .EQ. 'REF' .OR. & CTYPE(1:2) .EQ. 'SH' .OR. & CTYPE(1:2) .EQ. 'RQ') THEN C GET NAME OF REFERENCE IMAGES ANGLES DOCUMENT FILE CALL FILERD(REFANGDOC,NREFA,NULL, & 'REFERENCE IMAGES ANGLES DOCUMENT',IRTFLG) C FILERD WILL RETURN IRTFLG=1 IF "*" !!!! IF (REFANGDOC(:1) .EQ. '*' .OR.NREFA.LE.0) REFANGDOC = NULL ENDIF C FIND NUMBER OF REFERENCE-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,'NUMR',3*NRING) GOTO 9999 ENDIF C INITIALIZE NUMR ARRAY WITH RING RADII NRING = 0 DO I=MR,NR,ISKIP NRING = NRING+1 NUMR(1,NRING) = I ENDDO C CALCULATES NUMR & LCIRC CALL ALPRBS_Q_NEW(NUMR,NRING,LCIRC,MODE,IRAY) C FIND SPACE NEEDED FOR TT ON SGI FFT LENTT = 1 #ifdef SP_LIBFFT LENTT = NUMR(3,NRING) + 15 #endif C FIND NUMBER OF OMP THREADS CALL GETTHREADS(NUMTH) IASK8 = (LCIRC * NUMREF)*4 CALL BIGALLOC(IASK8,IOK,.FALSE.,.FALSE.,IRTFLG) IF (CTYPE(1:4) .EQ. 'REFF' .OR. & CTYPE(1:3) .EQ. 'SHF' .OR. & CTYPE(1:1) .EQ. 'I' ) THEN C INITIATE NON-INCORE EVEN IF SIZE IS OK ALLOCATE(CIRCREF(LCIRC,NUMTH),STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN IF (MYPID .LE. 0) WRITE(NOUT,92) LCIRC,NUMTH 92 FORMAT (' CAN NOT ALLOCATE: CIRCREF(',I8,' X ',I8,')') CALL ERRT(46,'CIRCREF',LCIRC*NUMTH) GOTO 9999 ENDIF IF (MYPID .LE. 0) WRITE(NOUT,93) LCIRC,NUMTH 93 FORMAT (' DISK BASED RINGS FILE, ALLOCATED: CIRCREF(',I8, & ' X ',I8,')') CIRCREF_IN_CORE = .FALSE. ELSE ALLOCATE(CIRCREF(LCIRC,NUMREF),STAT=IRTFLG) NTOT = LCIRC * NUMREF IF (IRTFLG .EQ. 0) THEN C CIRCREF ALLOCATION SUCCEEDED CIRCREF_IN_CORE = .TRUE. IF (MYPID .LE. 0) WRITE(NOUT,91) LCIRC,NUMREF,NTOT 91 FORMAT(' ALLOCATED: CIRCREF(',I8,' X ',I8,'): ',I10) ELSE IF (CTYPE(1:2) .EQ. 'MQ' .OR. CTYPE(1:2) .EQ. 'NQ') THEN IF (MYPID .LE. 0) THEN WRITE(NOUT,92) LCIRC,NUMREF WRITE(NOUT,*) & ' "AP NQ & AP MQ" MUST ALLOCATE CIRCREF. ' WRITE(NOUT,*) 7 ' USE "AP SH" AND USE FEWER REFERENCES.' ENDIF GOTO 9999 ENDIF CIRCREF_IN_CORE = .FALSE. IF (MYPID .LE. 0) WRITE(NOUT,90) LCIRC,NUMREF,NTOT 90 FORMAT(' CAN NOT ALLOCATE: CIRCREF(',I8,' X ',I8,'): ', & I10,' WILL USE REFERENCE-RINGS FILE.',/, & ' MAY BE VERY SLOW! ', & 'ADVISE YOU USE FEWER REFERENCES, INSTEAD.',/) C GWP - HAVE TO FIX THE ALLOCATION HERE FOR DEC UNIX IF (ALLOCATED(CIRCREF)) DEALLOCATE(CIRCREF) ALLOCATE(CIRCREF(LCIRC,NUMTH),STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'CIRCREF',LCIRC*NUMTH) GOTO 9999 ENDIF ENDIF ENDIF IF ((CTYPE(1:4) .EQ. 'MQ R') .OR. & (CTYPE(1:2) .EQ. 'AL') .OR. & (CTYPE(1:2) .NE. 'MQ' .AND. & CTYPE(1:2) .NE. 'NQ' .AND. & CTYPE(1:2) .NE. 'SH' .AND. & CTYPE(1:2) .NE. 'OR' .AND. & CTYPE(1:2) .NE. 'RQ') .OR. 7 (CTYPE(1:2) .EQ. 'SH' .AND. .NOT. CIRCREF_IN_CORE)) THEN C C ~9 IS TO ACCEPT EXTENSION IF FILE IS NAMED CALL FILERD(ASK,NA,NULL,'REFERENCE-RINGS~9',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 SCRFILE = ASK IF (ASK(1:NA) .EQ. 'W') THEN CALL ERRT(101, & 'OBSOLETE, USE: TO CREATE REFERENCE-RINGS FILE',N) GOTO 9999 ELSEIF (NA .LE. 3 .AND. ASK(1:1) .EQ. 'N' .AND. & .NOT. CIRCREF_IN_CORE) THEN CALL ERRT(101, & 'OBSOLETE, USE: TO CREATE REFERENCE-RINGS FILE',N) GOTO 9999 ELSEIF (NA .LE. 3 .AND. ASK(1:1) .EQ. 'Y') THEN SCRFILE = 'SCRATCH.file' IF (MYPID .LE. 0) WRITE(NOUT,*) & 'OBSOLETE, GIVE NAME FOR REFERENCE-RINGS FILE' ENDIF ELSE SCRFILE = CHAR(0) ENDIF IF (CTYPE(1:1) .EQ. 'I' .OR. CTYPE(1:2) .EQ. 'MI') THEN C ----------------- 'I' ------------------------ APRINGS_FILL C CREATE REFERENCE RINGS FILE FOR OUTPUT NSL = 1 CALL OPFILEC(0,.FALSE.,SCRFILE,LUNRING,'B',IFORM, & LCIRC,NUMREF,NSL,MAXIM,' ', .FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9990 C INITIALIZE FFTW3 PLANS FOR USE WITHIN OMP || SECTIONS CALL APRINGS_INIT_PLANS(NUMR,NRING, & FFTW_PLANS,NPLANS,IRTFLG) CALL APRINGS_FILL_NEW(INUMBR,NUMREF, & NSAM,NROW,NUMTH, & NRING,LCIRC,NUMR,MODE,FFTW_PLANS, & REFPAT,LUNREF, & CIRCREF,NUMTH,LUNRING,IRTFLG) CLOSE(LUNRING) GOTO 9989 ENDIF 399 IF (CTYPE(1:3) .EQ. 'RNS' .OR. & CTYPE(1:2) .EQ. 'OR') THEN C GET NAME OF SINGLE IMAGE TO BE ALIGNED MAXIM = 0 CALL OPFILEC(0,.TRUE.,EXPPAT,LUNEXP,'O',IFORM, & NSAM,NROW,NSLICE,MAXIM,'EXPERIMENTAL IMAGE', & .FALSE.,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 ALLOCATE(IMGLST(1),STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'IMGLST',1) GOTO 9999 ENDIF IMGLST(1) = 0 NUMEXP = 1 ELSE C GET LIST OF EXPERIMENTAL IMAGES TO BE ALIGNED ALLOCATE(IMGLST(NILMAX),STAT=IRTFLG) IF (IRTFLG .NE. 0) THEN CALL ERRT(46,'IMGLST',NILMAX) GOTO 9999 ENDIF CALL FILELIST(.TRUE.,LUNEXP,EXPPAT,NLEP, & IMGLST,NILMAX,NUMEXP, & 'ENTER TEMPLATE FOR IMAGE SERIES TO BE ALIGNED',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 IF (MYPID .LE. 0) WRITE(NOUT,2002) NUMEXP 2002 FORMAT(' Number of experimental images: ',I6) ENDIF EXPANGDOC = NULL IF ((CTYPE(1:2) .EQ. 'RN' .AND. CTYPE(3:3) .NE. 'S') .OR. & CTYPE(1:2) .EQ. 'RD' .OR. & CTYPE(1:2) .EQ. 'RQ' .OR. & CTYPE(1:2) .EQ. 'SH' .OR. & CTYPE(1:3) .EQ. 'REF') THEN C GET NAME OF DOC FILE HOLDING EXPERIMENTAL IMAGES ANGLES CALL FILERD(EXPANGDOC,NEXPA,NULL, & 'EXPERIMENTAL IMAGES ALIGNMENT DOCUMENT',IRTFLG) IF (NEXPA .EQ. 0 .OR.EXPANGDOC(:1) .EQ. '*')EXPANGDOC = NULL ENDIF RANGE = 0.0 ANGDIFTHR = 0.0 IF ((CTYPE(1:2) .EQ. 'RN' .AND. CTYPE(3:3) .NE. 'S') .OR. & CTYPE(1:2) .EQ. 'RD' .OR. & CTYPE(1:2) .EQ. 'RQ' .OR. & CTYPE(1:3) .EQ. 'REF' .OR. & CTYPE(1:2) .EQ. 'SH') THEN CALL RDPRM2S(RANGE,ANGDIFTHR,NOT_USED, & 'RANGE OF PROJECTION ANGLE SEARCH & ANGLE CHANGE THRESHOLD', & IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (RANGE .GT. 0.0 .AND. EXPANGDOC .EQ. NULL) THEN CALL ERRT(101, & 'MUST SPECIFY EXPERIMENTAL IMAGES ALIGNMENT DOCUMENT FILE', & IDUM) RANGE = 0.0 ENDIF RANGE = MIN(RANGE,180.0) ! 3D MAX. DIFFERENCE POSSIBLE ENDIF CKMIRROR = .TRUE. IF ((CTYPE(1:3) .EQ. 'REF') .OR. & CTYPE(1:3) .EQ. 'ORS' .OR. & CTYPE(1:2) .EQ. 'SH' ) THEN CALL RDPRI1S(IMIRROR,NOT_USED, & 'CHECK MIRRORED POSITIONS (0=NOCHECK / 1=CHECK)?',IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CKMIRROR = (IMIRROR .NE. 0) ELSEIF (CTYPE(1:2) .EQ. 'NQ' .OR. & CTYPE(1:3) .EQ. 'RQN' .OR. & CTYPE(1:2) .EQ. 'RN' .OR. & CTYPE(1:3) .EQ. 'ORN' ) THEN CKMIRROR = .FALSE. ENDIF C GET NAME FOR OUTPUT DOC FILE CALL REG_GET_USED(NSEL_USED) IF (FCHAR(1:2) .EQ. 'OR') THEN C NO OUTPUT FILE WANTED OUTANG = NULL NOUTANG = 0 ELSE C OPEN OUTPUT DOC FILE (FOR APPENDING) NOUTANG = NDOC CALL OPENDOC(OUTANG,.TRUE.,NLET,NDOC,NOUTANG,.TRUE., & 'OUTPUT ALIGNMENT DOCUMENT',.FALSE.,.TRUE.,.TRUE., & NEWFILE,IRTFLG) IF (IRTFLG .EQ. -1) THEN C DO NOT WANT OUTPUT DOC FILE NOUTANG = 0 ELSEIF (IRTFLG .NE. 0) THEN RETURN ELSE C WANT OUTPUT DOC FILE IF (CTYPE(1:3) .EQ. 'REF' .OR. CTYPE(1:2) .EQ. 'SH') THEN COMMEN =' ' // & 'PSI, THE, PHI, REF#, '// & ' EXP#, CUM. {INPLANE, SX, SY}, '// & ' NPROJ, DIFF, CCROT, '// & ' INPLANE, SX, SY, MIR-CC' ELSE COMMEN = ' ' // & 'MIR-REF#, CCROT, INPLANE <, SX, '// & 'SY, IMG#, < DIFF' ENDIF CALL LUNDOCPUTCOM(NOUTANG,COMMEN,IRTFLG) ENDIF ENDIF C -------PARAMETER INPUT FINISHED, CALCULATE NOW --------- C INITIALIZE FFTW3 PLANS FOR USE WITHIN OMP || SECTIONS CALL APRINGS_INIT_PLANS(NUMR,NRING, & FFTW_PLANS,NPLANS,IRTFLG) IF (CTYPE(1:3) .EQ. 'RNS') THEN C ----------------------- 'RNS'------------------------ DSGRS IF (MYPID .LE. 0)WRITE(NOUT,*) & ' Calling: DSGRS FOR: ',CTYPE(1:3),' --------------' CALL DSGRS(INUMBR,NUMREF,IMGLST,1, & NSAM,NROW,NR,LENTT, & NRING,LCIRC,NUMR,CIRCREF,CIRCREF_IN_CORE, & MODE,SCRFILE,FFTW_PLANS, & REFPAT,EXPPAT) ELSEIF (CTYPE(1:2) .EQ. 'MD') THEN C ------------------------- 'MD' ----------------------- DSFS IF (CIRCREF_IN_CORE .AND. NUMTH.GT.1 .AND. & NUMEXP .GT. NUMTH .OR. & CTYPE(3:3) .EQ. 'T') THEN IF (MYPID .LE. 0) WRITE(NOUT,*) & ' Calling: DSGR_PM FOR: ',CTYPE(1:3),' ------------' CALL DSGR_PM(INUMBR,NUMREF,IMGLST,NUMEXP, & NSAM,NROW,ANGDIFTHR,LENTT,RANGE, & NRING,LCIRC,NUMR,CIRCREF, & MODE,REFANGDOC,EXPANGDOC,SCRFILE,FFTW_PLANS, & REFPAT,EXPPAT,CKMIRROR,CTYPE,ISHRANGE,NOUTANG) ELSE IF (MYPID .LE. 0) WRITE(NOUT,*) & ' Calling: DSFS_P FOR: ',CTYPE(1:2),' -----------' CALL DSFS_P(INUMBR,NUMREF,IMGLST,NUMEXP, & NSAM,NROW,NR,LENTT, & NRING,LCIRC,NUMR,CIRCREF,CIRCREF_IN_CORE, & MODE,SCRFILE,REFPAT,EXPPAT,FFTW_PLANS(1)) ENDIF ELSEIF (CTYPE(1:3) .EQ. 'REF' .OR. & CTYPE(1:2) .EQ. 'RN' .OR. & CTYPE(1:2) .EQ. 'RD') THEN C --------------------'REF' or 'RN' or 'RD' ------------ DSGR IF ((CIRCREF_IN_CORE .AND. & NUMTH.GT.1 .AND. NUMEXP.GT.NUMTH) .OR. & CTYPE(3:3) .EQ. 'T' .OR. CTYPE(4:4) .EQ. 'T') THEN IF (MYPID .LE. 0) WRITE(NOUT,*) & ' Calling: DSGR_PM FOR: ',CTYPE(1:3),' -----------' CALL DSGR_PM(INUMBR,NUMREF,IMGLST,NUMEXP, & NSAM,NROW,ANGDIFTHR,LENTT,RANGE, & NRING,LCIRC,NUMR,CIRCREF, & MODE,REFANGDOC,EXPANGDOC,SCRFILE,FFTW_PLANS, & REFPAT,EXPPAT,CKMIRROR,CTYPE,ISHRANGE,NOUTANG) ELSE IF (MYPID .LE. 0) WRITE(NOUT,*) & ' Calling: DSGR_P FOR: ',CTYPE(1:3),' -----------' CALL DSGR_P(INUMBR,NUMREF,IMGLST,NUMEXP, & NSAM,NROW,LENTT,RANGE,ANGDIFTHR, & NRING,LCIRC,NUMR,CIRCREF,CIRCREF_IN_CORE, & MODE,REFANGDOC,EXPANGDOC,SCRFILE,FFTW_PLANS, & REFPAT,EXPPAT,CKMIRROR,CTYPE,ISHRANGE,NOUTANG) ENDIF ELSEIF (CTYPE(1:2) .EQ. 'MQ' .OR. & CTYPE(1:2) .EQ. 'NQ' .OR. & CTYPE(1:2) .EQ. 'RQ' .OR. & CTYPE(1:2) .EQ. 'SH' .OR. & CTYPE(1:2) .EQ. 'AL' .OR. & CTYPE(1:2) .EQ. 'OR') THEN C ---- ' SH', 'MQ', 'RQ', 'NQ', 'ORS', 'ORM', & 'ORN' ---- MRQLI IF (CIRCREF_IN_CORE .AND. & NUMEXP .GE. NUMTH .AND. & (CTYPE(3:3) .NE. 'T' .AND. & CTYPE(4:4) .NE. 'T') .AND. & (CTYPE(1:2) .NE. 'OR')) THEN C FOR MP, LARGE NUMBER OF IMAGES TO BE ALIGNED, OR SP. IF (MYPID .LE. 0) WRITE(NOUT,*) & ' Calling: MRQLI_PS FOR: ',CTYPE(1:3),' ----------' #if defined ( USE_MPI) && defined (MPI_DEBUG) T0 = MPI_WTIME() #endif CALL MRQLI_PS(INUMBR,NUMREF,IMGLST,NUMEXP, & NSAM,NROW,NR,LENTT,ISHRANGE,ISTEP, & NRING,LCIRC,NUMR,CIRCREF,CIRCREF_IN_CORE, & MODE, REFANGDOC,EXPANGDOC,SCRFILE,FFTW_PLANS, & REFPAT,EXPPAT,RANGE,CKMIRROR,CTYPE,NOUTANG) #if defined ( USE_MPI) && defined (MPI_DEBUG) T1 = MPI_WTIME() T1 = T1 - T0 IF (MYPID .EQ. 0) WRITE(6, 222) T1 222 FORMAT(' AP TIME: ', 1PE11.3) #endif ELSE C USE DIFFERENT STRATEGY FOR SMALL NUMBER OF SAMPLE IMAGES C OR FOR CIRCREF FROM RINGS FILE C TO MAKE MP EFFICIENT. ALSO FOR 'OR' OPERATIONS IF (MYPID .LE. 0) WRITE(NOUT,*) & ' Calling: MRQLI_SS FOR: ',CTYPE(1:3),' ----------' CALL MRQLI_SS(INUMBR,NUMREF,IMGLST,NUMEXP, & NSAM,NROW,NR,LENTT,ISHRANGE,ISTEP, & NRING,LCIRC,NUMR,CIRCREF,CIRCREF_IN_CORE, & MODE, REFANGDOC,EXPANGDOC,SCRFILE,FFTW_PLANS, & REFPAT,EXPPAT,RANGE,CKMIRROR,CTYPE,NOUTANG) ENDIF ENDIF C UNALLOCATE FFTW3 PLANS (TO REMOVE MEMORY LEAK) 9989 CALL FFTW3_KILLPLANS(FFTW_PLANS,NPLANS,IRTFLG) 9990 IF (MYPID .LE. 0 .AND. VERBOSE) WRITE (NOUT,2600) 2600 FORMAT (/' ',12('-'),' END OF COMPUTATION ',12('-')/) 9999 IF (ALLOCATED(IMGLST)) DEALLOCATE(IMGLST) IF (ALLOCATED(NUMR)) DEALLOCATE(NUMR) IF (ALLOCATED(CIRCREF)) DEALLOCATE(CIRCREF) CLOSE(NDOC) #ifdef USE_MPI_NEVER write(0,*) ' apmaster; at final barrier: ',mypid CALL MPI_BARRIER(ICOMM,MPIERR) write(0,*) ' apmaster; after final barrier: ',mypid #endif END