C++********************************************************************* C C DRIV1 C CHANGED READRQ PARAMETERS PASSED AUG 99 ARDEAN LEITH C "FR" REMOVED TO SPIDER SEPT 00 ARDEAN LEITH C "PO" FOR POLAR CONVERSION SEPT 00 C "FR L" ADDED MAR 01 ARDEAN LEITH C SIMPLIFED WITH SETSYMPAR IN RDPR APR 2001 ARDEAN LEITH C SYMPAR JUN 2002 ARDEAN LEITH C MULTILINE VMS SEP 2003 ARDEAN LEITH C 'MD' TO SPIDER.f DEC 2003 ARDEAN LEITH C 'VO IA' & 'VO EPT' AUG 2004 ARDEAN LEITH C 'PI IMG" JAN 2006 ARDEAN LEITH C C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2005 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 DRIV1(MAXDIM) C C PURPOSE: CALLS ROUTINES REMOVED FROM DRIVER IN MAR 93 C C PARAMETERS: MAXDIM MAX LENGTH OF COMMON BUFFER C C23456789 123456789 123456789 123456789 123456789 123456789 123456789 12 C--********************************************************************* SUBROUTINE DRIV1(MAXDIM) INCLUDE 'CMBLOCK.INC' INCLUDE 'CMLIMIT.INC' CHARACTER (LEN=1) :: NULL,SWITCH CHARACTER (LEN=4) :: CXNUM COMMON /DRIV1_COM/ T1,LOOPREG,CXNUM CHARACTER(LEN=2*MAXNAM) :: RESPONSE,PROMPT CHARACTER(LEN=7) :: EXTEN REAL, DIMENSION(103) :: SAVE INTEGER :: HRS,MIN,SEC LOGICAL :: MULTILINE c DATA MENU/'NC','VM','ME','CK','TM', c & 'SR','RR','FR','PO','SA', c & 'VO','EV','PI','PB'/ NULL = CHAR(0) LUNDOC = 77 SELECT CASE(FCHAR(1:2)) CASE('NC') ! NEW FILE EXTENSION -------------------------- NC CLOSE(NDAT) C GET THE PROJECT AND DATA EXTENSION 100 IRTFLG = -999 CALL RDPRMC(EXTEN,NC,.TRUE.,'ENTER PROJECT/DATA EXTENSION', & NULL,IRTFLG) C MAKE SURE PROJECT EXTENSION IS VALID IF (NC .LT. 3 .OR. IRTFLG .NE. 0) THEN WRITE(NOUT,*) ' *** EXTENSION MUST BE 3 CHARACTERS' GOTO 100 ENDIF PRJEXC(1:3) = EXTEN(1:3) IF (EXTEN(4:4) .NE. '/') THEN DATEXC(1:3) = PRJEXC(1:3) ELSE DATEXC(1:3) = EXTEN(5:7) ENDIF GOTO 9999 CASE('VM') ! VMS SPAWN COMMANDS SYSTEM CALL -------------- VM MULTILINE = (FCHAR(4:4) .EQ. 'M') CALL VMS(MULTILINE) GOTO 9999 CASE('ME') ! MENU LISTING -------------------------------- ME WRITE(NOUT,*)' OPERATION NO LONGER SUPPORTED, USE MANUAL INSTEAD' CALL ERRT(100,'DRIV1',NE) GOTO 9999 CASE('CK') ! CHECKPOINT OPERATION ------------------------ CK C WRITE OUT CURRENT OPERATION AND CURRENT ITERATION NUMBER. IF (NTRACE.NE.0) THEN WRITE(NOUT,9020) FCHAR(1:NALPH) 9020 FORMAT(' ',A) IF (IABSLP .NE. 0 .AND. LOOPREG .NE. 0) THEN IF (LOOPREG .LT. 103) THEN WRITE(NOUT,9040) LOOPREG,IABSLP 9040 FORMAT(' LOOP COUNTER (',I3,') = ',I5) ELSE WRITE(NOUT,9041) CHAR(LOOPREG-103),IABSLP 9041 FORMAT(' LOOP INDEX (',A,') = ',I5) ENDIF ENDIF ENDIF GOTO 9999 CASE('TM') ! TIME OPERATION ------------------------------ TM C GET NUMBER OF SEC. SINCE LAST TM, AND COMPUTE HOURS,MIN, & SEC TIM = SECNDS(T1) HRS = INT(TIM/3600.) HOUR = HRS*3600. MIN = INT((TIM-HOUR)/60.) SEC = TIM-HOUR-MIN*60. WRITE(NDAT,9240)HRS,MIN,SEC 9240 FORMAT(' TIME: ',I2,' HOURS ',I2,' MINUTES ',I2,' SECONDS') GOTO 9999 CASE('SR') ! SAVE REGISTERS ------------------------------ SR CALL RDPRMC(SWITCH,NLET,.TRUE.,'(S)AVE OR (U)NSAVE',NULL,IRT) IF (IRT .NE. 0) GOTO 9999 CALL ERRT(101,'OBSOLETE - OPERATION NO LONGER SUPPORTED',NE) GOTO 9999 C IF (SWITCH .EQ. 'S') THEN C SAVE THE REGISTERS C CALL REG_SAVE(IRTFLG) C ELSEIF (SWITCH .EQ. 'U') THEN C UNSAVE THE REGISTERS C CALL REG_UNSAVE(IRTFLG) C ELSE C WRITE(NOUT,*) ' *** UNKNOWN SR OPTION' C GOTO 600 C ENDIF C GOTO 9999 CASE('RR') ! READ REGISTER ------------------------------- RR CALL READRQ() GOTO 9999 CASE('FR') ! FILE READ ----------------------------------- FR CALL SYMPAR(LUNDOC) GOTO 9999 CASE('PO') ! POLAR CONVERSION --------------------------- PO CALL TO_POLAR() GOTO 9999 CASE('SA') ! SUM ALIGNMENTS --------------------------- SA IF (FCHAR(4:4) .EQ. 'P') THEN CALL SUMALI(.TRUE.) ELSEIF(FCHAR(4:4) .EQ. '3') THEN CALL SUMALI3 ELSEIF(FCHAR(4:4) .EQ. 'E') THEN CALL SUMEULER ELSE CALL SUMALI(.FALSE.) ENDIF GOTO 9999 CASE('VO') ! ------------------------------------------- VO IF (FCHAR(4:5) .EQ. 'EA') THEN CALL VOEA(MAXDIM) ELSEIF (FCHAR(4:6) .EQ. 'NEA') THEN CALL VONEA() ELSEIF (FCHAR(4:6) .EQ. 'RAS') THEN CALL VORA(MAXDIM) ELSEIF (FCHAR(4:5) .EQ. 'RA') THEN CALL VORA(MAXDIM) ELSEIF (FCHAR(4:5) .EQ. 'TA') THEN CALL VOTA(MAXDIM) ELSEIF (FCHAR(4:5) .EQ. 'MD') THEN CALL VOMD ELSEIF (FCHAR(4:5) .EQ. 'MQ') THEN CALL VOMQ ELSEIF (FCHAR(4:5) .EQ. 'DA') THEN CALL VODA ELSEIF (FCHAR(4:5) .EQ. 'EP') THEN CALL VOEPT ELSEIF (FCHAR(4:5) .EQ. 'IA') THEN CALL VOIA ENDIF GOTO 9999 CASE('EV') ! ---SET ENVIRONMENTAL VARIABLE ------------ EV IRTFLG = -999 C IRTFLG = -999 DOES NOT CONVERT INPUT TO UPPERCASE #if defined(__osf__) CALL ERRT(101,'OPERATION NOT AVAILBLE IN COMPAQ F90',IDUM) #else CALL RDPRMC(PROMPT,NLET1,.TRUE.,'ENVIRONMENT VARIABLE', & NULL,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 IRTFLG = -999 CALL RDPRMC(RESPONSE,NLET2,.TRUE.,'VALUE',NULL,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL SETENV(PROMPT(1:NLET1),RESPONSE(1:NLET2),IRTFLG) #endif GOTO 9999 CASE('PI') ! --- SEND REGISTER DOWN PIPE ------------------ PI IF (FCHAR(4:4) .EQ. 'R') THEN C SEND REGISTER DOWN PIPE ---------------------------- PI REG IRTFLG = -999 CALL RDPRMC(RESPONSE,NCHAR,.TRUE.,'REGISTER VARIABLE', & CDUM,IRTFLG) IF (IRTFLG .NE. 0) GOTO 9999 CALL REG_PIPE(RESPONSE,IRTFLG) ELSE C SEND IMAGE DOWN PIPE ------------------------------- PI IMG CALL WRTLIN_PIPE_TOG() ENDIF GOTO 9999 CASE('PB') ! --- MANIPULATE PDB FILES ------------------- PB CALL PDB GOTO 9999 END SELECT 9999 RETURN END