C++*************************************************************************
C
C VMS.F                         
C                             REMOVED FILNAMSUB   APR 2001 ARDEAN LEITH
C                             MULTILINE           SEP 2003 ARDEAN LEITH
C                             RDPR PARAMETERS     04/14/05 ARDEAN LEITH
C                             [_d] --> xd         03/24/06 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   VMS  SOLICTS SYSTEM COMMAND AND THEN RUNS THAT COMMAND 
C
C--*******************************************************************

	SUBROUTINE VMS(MULTILINE)

	INCLUDE 'CMBLOCK.INC' 

	CHARACTER(LEN=160)  :: COMLIN
	CHARACTER(LEN=1600) :: COMMAN
        INTEGER             :: system
        LOGICAL             :: MULTILINE,GETANS,STRIP
        LOGICAL             :: UPPER,WANTSUB,SAYPRMT,SAYANS,ENDATSEMI

#ifdef USE_MPI
        INCLUDE 'mpif.h'
        ICOMM = MPI_COMM_WORLD
        CALL MPI_COMM_RANK(ICOMM, MYPID, IERR)
#else
        MYPID = -1
#endif

        COMMAN = CHAR(0)

C       DO NOT UPPERCASE THE INPUT LINE, DO NOT STRIP AFTER ;
        UPPER     = .FALSE.
        WANTSUB   = .TRUE.
        SAYPRMT   = .TRUE.
        SAYANS    = .FALSE.
        ENDATSEMI = .FALSE.
        GETANS    = .TRUE.
        STRIP     = .FALSE.

        CALL RDPR('SYSTEM COMMAND',NC,COMMAN,GETANS,
     &             UPPER,WANTSUB,SAYPRMT,SAYANS,ENDATSEMI,STRIP,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN
 
        IF (MULTILINE) THEN
C          DO NOT UPPERCASE THE INPUT LINE, DO NOT STRIP AFTER ;
10         SAYPRMT   = .FALSE.
           CALL RDPR('',NCM,COMLIN,GETANS,
     &             UPPER,WANTSUB,SAYPRMT,SAYANS,ENDATSEMI,STRIP,IRTFLG)
           IF (IRTFLG .NE. 0) RETURN

           IF (NCM .GT. 1 .OR. COMLIN(1:1) .NE. '.') THEN
C              CONCATENATE WITH COMMAN
               IF ((NC + NCM) .GT. 1600) THEN
                  CALL ERRT(101,'COMMAND LIMITED TO 1600 CHAR.',NDUM)
                  RETURN
               ENDIF
               COMMAN = COMMAN(1:NC) // COMLIN(1:NCM)
               NC     = NC + NCM
               GOTO 10
           ENDIF
        ENDIF                

cc        write(6,*) comman(:nc)

        IF (NC .LT. 160) COMMAN(NC+1:NC+1) = CHAR(0)
        NC = LNBLNKN(COMMAN)

        CALL DEBRAKXREG(COMMAN,NC)

        IF (MYPID .LE. 0) THEN
           IF (NC .LE. 80) THEN
              WRITE(NOUT,90)COMMAN(1:NC)
              IF (NDAT .NE. NOUT) WRITE(NDAT,90)COMMAN(1:NC)
   90         FORMAT(/,1X,A)
           ELSE
              DO I=1,NC,80
                 WRITE(NOUT,91) COMMAN(I:I+79)
                 IF (NDAT .NE. NOUT) WRITE(NDAT,91)COMMAN(I:I+79)
   91            FORMAT(' ',A)
              ENDDO
           ENDIF
           IF (VERBOSE) WRITE(NOUT,*) ' '

           IRET = system(COMMAN(1:NC))
        ENDIF

        RETURN
	END

C      *********************** DEBRAKXREG ********************************

       SUBROUTINE DEBRAKXREG(CINPUT,NCHAR)

       CHARACTER(LEN=*)   :: CINPUT
       CHARACTER(LEN=161) :: CSUB
       LOGICAL            :: ISDIGI

C        CONVERT NEW: [name] FORMAT to OLD x11 REGISTER FORMAT
         I     = 1
         DO WHILE (I .LT. (NCHAR - 3))
            IF (CINPUT(I:I+1) .EQ. '[_') THEN
C              START OF [_
               J = I + 2
               DO WHILE (J .LE. NCHAR)
                  IF (ISDIGI(CINPUT(J:J))) THEN
                     J = J + 1
                     CYCLE 
                  ENDIF
                  EXIT
               ENDDO

               IF (CINPUT(J:J) .NE. ']') THEN
                  I = I + 1
                  CYCLE                 ! NOT A [_ddd]
               ENDIF

               NDIG = J - I -2 
               IF (NDIG .LT. 1) THEN
                  I = I + 1
                  CYCLE                 ! NO dd in:  [_]
               ENDIF

               CINPUT(I:I) = 'X'
               CSUB = 'X' // CINPUT(I+2:J)
               CALL SUBCHAR(CSUB(1:NDIG+1),CINPUT,I,J,NCHAR,IRTFLG)
               I = J -1
            ENDIF
            I = I + 1
         ENDDO

         END