C++********************************************************************* C C SAVDOCQ.F REWRITTEN SEPT 96 ArDean Leith C USED LUNDOC JUNE 99 ArDean Leith C OPENDOC PARAMETERS DEC 2000 ARDEAN LEITH C FLUSH SEP 2002 ArDean Leith C INCORE OPENDOC JUL 2003 ARDEAN LEITH C LUNDOCWRTDAT FLUSHES OCT 2003 ARDEAN LEITH C REMOVED / FROM COMMENT JUN 2008 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 SAVDOCQ(DOCNAM,NLET,IRTFLG) C C PURPOSE: SUBROUTINE TO SAVE PARTICULAR REGISTERS IN A C FILE-BASED DOCUMENT FILE. CALLED FROM COMMAND LINE. C C OPERATION USAGE: C SD X0,X15,X20,X5 C SD E (END DOC FILE USAGE, CLOSE FILE) C SD /NEW COMMENT FOR DOC. FILE C C PARAMETERS: C DOCNAME FILE NAME (SENT) C NLET NUMBER OF CHAR IN DOCNAME (SENT) C IRTFLG ERROR FLAG (RETURNED) C C23456789012345678901234567890123456789012345678901234567890123456789012 C--********************************************************************* SUBROUTINE SAVDOCQ(DOCNAM,NLET,IRTFLG) INCLUDE 'CMLIMIT.INC' INCLUDE 'CMBLOCK.INC' CHARACTER(LEN=*) :: DOCNAM C MAX. NUMBER OF SIMULTANEOUS DOCUMENT FILES ALLOWED INTEGER, PARAMETER :: MAXICDOCS = 20 CHARACTER(LEN=MAXNAM) :: DCFILE(MAXICDOCS) C MAXIMUM NUMBER OF REGISTERS SAVED INTEGER, PARAMETER :: MAXLIST=50 REAL :: DLIST(MAXLIST) INTEGER :: ILIST(MAXLIST) LOGICAL :: NEWFILE,COMOUT C NEEDED FOR FUTURE CALLS SAVE DCFILE, ICLAST DATA DCFILE/MAXICDOCS*'*'/ DATA ICLAST/0/ #ifdef USE_MPI INCLUDE 'mpif.h' INTEGER MYPID, COMM, MPIERR COMM = MPI_COMM_WORLD CALL MPI_COMM_RANK(COMM, MYPID, MPIERR) #else MYPID = -1 #endif C SET ERROR RETURN IRTFLG = 1 IF (FCHAR(4:4) .EQ. 'E') THEN C WANT TO CEASE USING A DOC FILE ----------------------------- C DETERMINE WHICH OF THE OLD NAMES NEEDS TO BE CLOSED DO IC=1,MAXICDOCS IF (DOCNAM .EQ. DCFILE(IC)) THEN C CHANGE DCFILE SO THAT IT CANNOT BE MATCHED WITH ANY FILE NAME. DCFILE(IC) = '*' CLOSE(200+IC) IRTFLG = 0 RETURN ENDIF ENDDO IF (MYPID .LE. 0)WRITE(NOUT,*) ' DOCUMENT FILE NOT OPEN NOW ' RETURN ENDIF C COMPARE NEW DOCUMNET FILE WITH OLD NAMES --------------------- IC = 0 C NAME IS MOST-LIKELY STILL THE SAME IF (ICLAST .GT. 0 .AND. ICLAST .LE. MAXICDOCS .AND. & DOCNAM .EQ. DCFILE(ICLAST)) THEN C DOCNAM IS ALREADY IN-CORE IC = ICLAST NDOC = 200 + IC GOTO 14 ENDIF C FILL FROM FRONT TO BACK DO ICT = 1,MAXICDOCS IF (DOCNAM .EQ. DCFILE(ICT)) THEN C DOCNAM IS ALREADY OPEN IC = ICT NDOC = 200 + IC GOTO 14 ENDIF C REMEMBER FIRST EMPTY LOCATION IF (IC .EQ. 0 .AND. DCFILE(ICT) .EQ. '*') IC = ICT ENDDO C DOCUMENT NAME NOT FOUND IN LIST. IF (IC .EQ. 0) THEN C LIST FULL, CLOSE SOMETHING & OPEN THIS IC = ICLAST + 1 IF (IC .GT. MAXICDOCS) IC = 1 DCFILE(IC) = '*' CLOSE(200 + IC) ENDIF C OPEN DOC FILE ON UNIT IC + 200 NDOC = IC + 200 C FILE MAY NOT HAVE BEEN ACCESSED YET TODAY, PUT NEW HEADER IN CALL OPENDOC(DOCNAM,.FALSE.,NLET,NDOC,NIC,.FALSE.,' ', & .FALSE.,.TRUE.,.TRUE.,NEWFILE,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (NIC .LE. 0) THEN CALL ERRT(101,'USE FOR INCORE DOC FILE.',NE) RETURN ENDIF C PUT NAME IN LIST OF OPENED FILES DCFILE(IC)= DOCNAM ICLAST = IC C PARSE REGISTER LINE, CHECK FOR IKEY & NLIST ------------------ 14 CALL REG_DOC_PARSE(FCHAR(4:),COMOUT,IKEY,NLIST,IRTFLG) IF (IRTFLG .NE. 0) RETURN IF (COMOUT) THEN C JUST WANT TO PUT A COMMENT IN THE DOC FILE. IF (MYPID .LE. 0) WRITE(NDOC,94) FCHAR(5:) 94 FORMAT(' ; ',A) IRTFLG = 0 RETURN ENDIF IF (MAXLIST .LT. NLIST) THEN CALL ERRT(102,'MAX. NUMBER OF REGISTERS',MAXLIST) NLIST = MAXLIST ENDIF C RETRIEVE DATA FROM THE REGISTER(S) LISTED IN NSEL INTO: DLIST CALL REG_GET_NSELA(NLIST,DLIST,IRTFLG) C WRITE DATA FROM DLIST INTO DOC FILE FOR THIS KEY CALL LUNDOCWRTDAT(NDOC,IKEY,DLIST,NLIST,IRTFLG) C LEAVE FILE OPEN, FOR NEXT USE IRTFLG = 0 RETURN END