Date: Thu, 21 May 87 11:55:29 edt From: gatech!rutgers!alliant.Alliant.COM!howell@anl-mcs.ARPA (Bob Howell) >From: Phil Neray at Alliant Contents: IBSS file - This is the first half of the program vtu.for PROGRAM VTU C***************************************************************************** C C TITLE: VAX/VMS DCL to Concentrix (Unix Berkeley 4.2) Conversion C AUTHOR: Glen D. West C DATE: August, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This program reads the VAX/VMS DCL command procedure and C converts the DCL commands to the equivalent C Shell Script C commands that run under the ALLIANT CONCENTRIX operating C system which is a Berkeley Unix 4.2 system. In addition, C it creates the two command files that serve as the input C to the FTP utility when invoked by ALLIANT.COM after this C procedure terminates. The two files are FTPGETx.COM and C FTPSENDx.COM, where "x" is the job number of the particular C job in case there are multiple jobs running. FTPSENDx.COM C contains the commands and filenames necessary to send the C created C shell script file, the input data files, the C source files for any programs that will be recompiled on the C FX/1 and the include files that are associated with these C source files. FTPGETx.COM contains the commands and filenames C necessary to get the output files and the log file created C on the FX/1 and delete those files on the FX/1. C C INPUTS: C C The following two inputs are read in from the 'RUNFLAG' C file created by the ALLIANT.COM command procedure: C C VAXDCLFILE - File Specification of the VAX FORTRAN command C file to be converted and run on the ALLIANT C FX/1 C JOBNUM - Job Number of the submitted job C C OUTPUTS: C VTU outputs a single C Shell Script file which is equivalent C to the VAX DCL input command file, two FTP utility command C files to SEND and GET the files from the FX/1 and an C FX/FORTRAN source code file that corresponds to each object C module file name listed in the DCL LINK statement. C C CALLED BY: C C N/A C C CALLS TO: C C VTU_INIT - VTU INITialization processing C VTU_PARSE - VTU command line PARSEr C VTU_EOF - VTU End Of File processing C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 JOBNUM ! Number of the job C CHARACTER*32 VAXDCLFILE ! Name of the DCL command file C CHARACTER*80 DCL_RECORD ! Input DCL command card C C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA VAXDCLUNIT /1/, ! DCL command file input channel * CSCRIPTUNIT /2/, ! C Shell Script file output channel * FTPSENDUNIT /3/, ! FTP SEND file output channel * FTPGETUNIT /4/ ! FTP GET file output channel C C******************************************************************************* C C C******************************************************************************* C C Read the filename of the input DCL command file and the job number C and do the necessary VTU initialization. C C******************************************************************************* C READ(99,200)VAXDCLFILE READ(99,300)JOBNUM CALL VTU_INIT(VAXDCLFILE,JOBNUM) C******************************************************************************* C C As long as not to the end of the DCL command file, read a command, C output a commented out copy of it to the C Shell Script file being C constructed and invoke the VTU command line parser to process the C command. C C******************************************************************************* DO WHILE (.TRUE.) READ(VAXDCLUNIT,400,END=100)DCL_RECORD WRITE(CSCRIPTUNIT,500)DCL_RECORD CALL VTU_PARSE(DCL_RECORD,JOBNUM) ENDDO 100 CONTINUE C******************************************************************************* C C Perform the necessary VTU end of file processsing C C******************************************************************************* CALL VTU_EOF(JOBNUM) C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 200 FORMAT(A32) 300 FORMAT(A1) 400 FORMAT(A80) 500 FORMAT('#',A72) END SUBROUTINE VTU_APPEND(DCL_RECORD) C******************************************************************************* C C TITLE: VTU APPEND Statement Conversion C AUTHOR: Glen D. West C DATE: February, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This routine converts the VMS DCL "APPEND" command C to the equivalent "cat" command of 4.2 BSD Unix and C outputs the built Unix command to the C Shell command C script being constructed. The file specifications are C converted from VMS to Unix specifications, including C the conversion to lower case and any necessary variable C substition in the filenames. C C INPUTS: C C DCL_RECORD - Input card containing DCL "APPEND" command C C OUTPUTS: C C None C C CALLED BY: C C VTU_PARSE - Command Line Parser C C CALLS TO: C C VTU_GETFILE - Returns next VMS file specification from C specified character string C VTU_VAR_EXP - Returns variable value and equivalent Unix C variable string for DCL variables character C strings C VTU_VAR_INS - Replaces a variable in a character string C with specified character string C VTU_FSCON - Converts file specifications from VMS to C Unix C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 GT_SIGN, ! Greater than symbol * QUOTE, ! Single quote character * SPACE ! Space character C CHARACTER*13 UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " C CHARACTER*32 VAR_VALUE ! DCL variable value CHARACTER*64 UNIXFILE(2), ! Unix equivalents of VMS file C ! specfications * VMSFILE(2) ! VMS file specifications in command C ! line CHARACTER*80 DCL_RECORD, ! Input DCL command card * WRITE_BUFFER ! Output buffer INTEGER LOWERCASE ! Change to lowercase indicator C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA GT_SIGN /'>'/, * LOWERCASE /1/, * QUOTE /39/, ! Single quote = 39 decimal * SPACE /' '/ C C******************************************************************************* C C C******************************************************************************* C C The "APPEND" command will have two file specifications as C arguments. Get the two file specifications and check if they C contain DCL variables. If they contain DCL variables insert C equivalent Unix string to evaluate the variable into the C file specification name. Convert each file specification to C the corresponding specification for a Unix file and covert C them to lowercase. C C******************************************************************************* C DO I = 1,2 DCL_RECORD = * DCL_RECORD(INDEX(DCL_RECORD,SPACE)+1:LEN(DCL_RECORD)) CALL VTU_GETFILE(DCL_RECORD,VMSFILE(I)) IF (INDEX (VMSFILE(I),QUOTE) .NE. 0) * THEN CALL VTU_VAR_EXP(VMSFILE(I),VAR_VALUE,UNIX_STR) CALL VTU_VAR_INS(VMSFILE(I),UNIX_STR,VMSFILE(I)) ENDIF CALL VTU_FSCON(VMSFILE(I),UNIXFILE(I)) CALL VTU_CHCASE(UNIXFILE(I),UNIXFILE(I),LOWERCASE) ENDDO C******************************************************************************* C C Build the Unix "cat" command argument list in the write buffer C and output it the C Shell command script being constructed as: C C cat unixfile1 >> unixfile2 C C******************************************************************************* C WRITE_BUFFER = UNIXFILE(1)(1:INDEX(UNIXFILE(1),SPACE))// * GT_SIGN//GT_SIGN//SPACE// * UNIXFILE(2)(1:INDEX(UNIXFILE(2),SPACE)) WRITE(CSCRIPTUNIT,100)WRITE_BUFFER RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT('cat ',A75) END SUBROUTINE VTU_ASSIGN(DCL_RECORD) C******************************************************************************* C C TITLE: VTU ASSIGN Statement Conversion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This routine converts the VMS DCL "ASSIGN" command C to the equivalent "setenv" command of 4.2 BSD Unix and C outputs the built Unix command to the C Shell command C script being constructed. The file specifications are C converted from VMS to Unix specifications, including C the conversion to lower case and any necessary variable C substition in the filenames. If the ASSIGN statement is C assigning a file specification to a FORTRAN I/O unit, C (i.e. FORxxx where xxx = 0,1,...99) then the VMS C logical (non-expanded VMS DCL variables) and physical (DCL C variables expanded) file specifications are added to C the GET LIST global data arrays for later reference. They C will be used to determine whether the assignment statement C indicates an output file assignment statement or is part C of an (ASSIGN,COPY) pair indicating an input file assignment. C This distinction is necessary, in order to determine which C files must be transmitted to the FX/1 to run the job and C which files must be retrieved from the FX/1 when the job C terminates. The restriction has been placed on the DCL C command jobs that an ASSIGN statement by itself cannot be C used to indicated input file assignment, either a COPY or C (ASSIGN,COPY) pair must be used and the ASSIGN statement C by itself is deemed an output file assignment statement C only for these necessary machine-to-machine file transfers. C C INPUTS: C C DCL_RECORD - Input card containing DCL "ASSIGN" command C C OUTPUTS: C C None C C CALLED BY: C C VTU_PARSE - Command Line Parser C C CALLS TO: C C VTU_GETFILE - Returns next VMS file specification from C specified character string C VTU_VAR_EXP - Returns variable value and equivalent Unix C variable string for DCL variables character C strings C VTU_VAR_INS - Replaces a variable in a character string C with specified character string C VTU_FSCON - Converts file specifications from VMS to C Unix C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C IO file arrays containing symbolic or logical equivalents of C names of files comprising FTP GET list and their actual or C physical file names C COMMON /GET_LIST/ LO_FILES(100), * PHY_FILES(100) C CHARACTER*64 LO_FILES, * PHY_FILES C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 QUOTE, ! Single quote character * SPACE ! Space character C CHARACTER*3 FORSPEC ! "FOR" Fortran IO file characters C CHARACTER*4 SYS_DOLLAR ! "SYS$" VMS system characters C CHARACTER*13 UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " C CHARACTER*32 VAR_VALUE(2) ! DCL variable values CHARACTER*64 GETFILE, ! File to retrieve from the FX/1 * LO_FILE, ! Logical VMS file specfication C ! (i.e. unexpanded DCL variables) * UNIXFILE(2), ! Unix equivalent of VMS file C ! specifications * VMSFILE(2) ! VMS file specifications C CHARACTER*80 DCL_RECORD, ! Input DCL command card * WRITE_BUFFER ! Output buffer C INTEGER FOR_CHAN, ! Integer value of "xxx" in "FORxxx" C ! Fortran IO unit specification * LOWERCASE, ! Change to lowercase indicator * UPPERCASE ! Change to uppercase indicator C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA FORSPEC /'FOR'/, * LOWERCASE /1/, * QUOTE /39/, ! Single quote = 39 decimal * SPACE /' '/, * SYS_DOLLAR /'SYS$'/, * UPPERCASE /-1/ C C******************************************************************************* C C C******************************************************************************* C C The "ASSIGN" command will have two file specifications as C arguments. Get the two file specifications and check if they C contain DCL variables. If they contain DCL variables insert C the equivalent Unix string to evaluate the variable into the C file specification name. Convert each file specification to C the corresponding specification for a Unix file. C C******************************************************************************* C DO I = 1,2 DCL_RECORD = * DCL_RECORD(INDEX(DCL_RECORD,SPACE)+1: * LEN(DCL_RECORD)) CALL VTU_GETFILE(DCL_RECORD,VMSFILE(I)) IF (INDEX(VMSFILE(I),QUOTE) .EQ. 0) * THEN UNIXFILE(I) = VMSFILE(I) ELSE CALL VTU_VAR_EXP(VMSFILE(I),VAR_VALUE(I),UNIX_STR) CALL VTU_VAR_INS(VMSFILE(I),UNIX_STR,UNIXFILE(I)) ENDIF CALL VTU_FSCON(UNIXFILE(I),UNIXFILE(I)) ENDDO C******************************************************************************* C C Convert the second VMS file specification and the first C Unix file specification to lowercase. Assign the logical file C to the unexpanded version of the first VMS file specification C and then insert the DCL variable value into the first VMS file C specification. Note that if there is no variable in the first C file specification the null string is inserted into it, thereby C not changing the file specification. C C******************************************************************************* CALL VTU_CHCASE(VMSFILE(2),VMSFILE(2),UPPERCASE) CALL VTU_CHCASE(UNIXFILE(1),UNIXFILE(1),LOWERCASE) LO_FILE = VMSFILE(1) CALL VTU_VAR_INS(VMSFILE(1),VAR_VALUE(1),VMSFILE(1)) C******************************************************************************* C C If the assignment statement is for a defined system file C (SYS$INPUT,SYS$OUTPUT,SYS$ERROR, or SYS$COMMAND) no action C is taken. If it is not, and is the assignment of a FORTRAN C IO unit (i.e. the second file specification is "FORxxx" as C previously defined), then put the logical (unexpanded DCL C variables) and physical (expanded DCL variables) into the C global GET LIST data arrays. Finally, construct the C arguments to the "setenv" command and output the command to C to C Shell command script being constructed in the form: C C setenv unixfile2 unixfile1 C C Notice that the Unix "setenv" arguments are in reverse order C from those of the VMS "ASSIGN" command. C C******************************************************************************* IF (INDEX(VMSFILE(2),SYS_DOLLAR) .EQ. 0) * THEN IF (VMSFILE(2)(1:3) .EQ. FORSPEC) * THEN DECODE(2,100,VMSFILE(2)(5:6))FOR_CHAN LO_FILES(FOR_CHAN+1) = LO_FILE PHY_FILES(FOR_CHAN+1) = VMSFILE(1) ENDIF WRITE_BUFFER = * UNIXFILE(2)(1:INDEX(UNIXFILE(2),SPACE))// * UNIXFILE(1)(1:INDEX(UNIXFILE(1),SPACE)) WRITE(CSCRIPTUNIT,300)WRITE_BUFFER ENDIF RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT(I2) 200 FORMAT(' get ',A64,/,' delete ',A64) 300 FORMAT('setenv ',A72) END SUBROUTINE VTU_CHCASE(IN_STRING,OUT_STRING,CASE) C******************************************************************************* C C TITLE: VTU CHange CASE C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This routine changes lowercase alphabetic strings C to uppercase or uppercase alphabetic strings to C lowercase depending on the input. Non-alphabetic C characters in a string are left unchanged. C C INPUTS: C C IN_STRING - Input string the be case converted C CASE - Case change direction indicator C 1 ==> Convert to lowercase C -1 ==> Convert to uppercase C C OUTPUTS: C C OUT_STRING - Output string after conversion C C CALLED BY: C C Numerous routines C C CALLS TO: C C None C C******************************************************************************* C C GLOBALS: C C None C C******************************************************************************* C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*(*) IN_STRING ! Input string CHARACTER*(*) OUT_STRING ! Output string INTEGER CASE, ! Case change direction indicator * CASE_MASK ! Mask difference in ASCII between C ! upper and lower case alphabetic C ! characters C C******************************************************************************* C C DATA: C C None C C******************************************************************************* C C C******************************************************************************* C C Assign the case mask to the case change direction * case mask value C since: C ASCII(lowercase letter) = ASCII(uppercase letter) + 32 C C where the 32 is decimal. Conversion to lowercase is therefore C done by adding 32, and conversion to uppercase by subtracting 32. C C******************************************************************************* C CASE_MASK = 32 CASE_MASK = CASE*CASE_MASK C******************************************************************************* C C Walk through the string converting uppercase letters to lowercase C if CASE is positive 1, or lowercase letters to uppercase if CASE C is negative 1. Characters outside the correct ranges are simply C copied to the output string. C C******************************************************************************* DO I = 1,LEN(IN_STRING) IF ((CASE .EQ. 1 .AND. * IN_STRING(I:I) .GE. 'A' .AND. * IN_STRING(I:I) .LE. 'Z') * .OR. * (CASE .EQ. -1 .AND. * IN_STRING(I:I) .GE. 'a' .AND. * IN_STRING(I:I) .LE. 'z')) * THEN OUT_STRING(I:I) = CHAR(ICHAR(IN_STRING(I:I))+CASE_MASK) ELSE OUT_STRING(I:I) = IN_STRING(I:I) ENDIF ENDDO RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C None C C******************************************************************************* C END SUBROUTINE VTU_COMPRESS(DCL_RECORD) C******************************************************************************* C C TITLE: VTU COMPRESS Character String C AUTHOR: Glen D. West C DATE: February, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This routine takes the input string and removes all C leading spaces up to the "$" character for the DCL C command. It then removes all spaces between the "$" C character and the DCL command. Finally, it replaces C all occurrences of multiple spaces between character C substrings of the remaining portion of the command C string with single spaces. This leaves exactly one C space between each argument of a DCL command. C C INPUTS: C C DCL_RECORD - Input DCL command card C C OUTPUTS: C C DCL_RECORD - Compressed DCL command card C C CALLED BY: C C VTU_PARSE - Command Line Parser C VTU_LINK - VTU LINK statement converter C C CALLS TO: C C None C C******************************************************************************* C C GLOBALS: C C None C C******************************************************************************* C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 SPACE, ! Space Character * TAB ! Horizontal Tab Character C CHARACTER*2 DB_SPACE ! Double Space Character C CHARACTER*80 DCL_RECORD ! Input DCL Command card C INTEGER EOL, ! End of line marker * PNTR1 ! String Pointer C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA DB_SPACE /' '/, * SPACE /' '/, * TAB /9/ ! ASCII(Horizontal tab) = decimal 9 C C******************************************************************************* C C C******************************************************************************* C C Get the length of the record, remove leading spaces and tabs C and spaces and tabs between the "$" and the DCL command. C C******************************************************************************* C EOL = LEN(DCL_RECORD) DO WHILE (DCL_RECORD(1:1) .EQ. SPACE .OR. * DCL_RECORD(1:1) .EQ. TAB) DCL_RECORD(1:EOL) = DCL_RECORD(2:EOL) ENDDO DO WHILE (DCL_RECORD(2:2) .EQ. SPACE .OR. * DCL_RECORD(2:2) .EQ. TAB) DCL_RECORD(2:EOL) = DCL_RECORD(3:EOL) ENDDO C******************************************************************************* C C If multiple spaces and tabs exist in the command string C replace them with a single space. C C******************************************************************************* IF (INDEX(DCL_RECORD,DB_SPACE) .NE. 0 .OR. * INDEX(DCL_RECORD,TAB) .NE. 0) * THEN PNTR = 1 DO WHILE (PNTR .LT. EOL) IF (DCL_RECORD(PNTR:PNTR) .EQ. TAB) * THEN DCL_RECORD(PNTR:PNTR) = SPACE ENDIF IF (DCL_RECORD(PNTR:PNTR+1) .EQ. DB_SPACE .OR. * DCL_RECORD(PNTR:PNTR+1) .EQ. SPACE//TAB) * THEN DCL_RECORD(PNTR:EOL) = DCL_RECORD(PNTR+1:EOL) ENDIF PNTR = PNTR + 1 ENDDO ENDIF RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C None C C******************************************************************************* C END SUBROUTINE VTU_CONSC(IFILE,OFILE,JOBNUM) C******************************************************************************* C C TITLE: VTU CONvert Source Code C AUTHOR: Glen D. West C DATE: July, 1986 C LANG: VAX DCL C C PURPOSE: C This routine converts VAX FORTRAN source code to C FX/FORTRAN source code. Currently, it only converts C the INCLUDE statements of a VAX FORTRAN source file C to the suitable format (Unix BSD 4.2 file specifications) C to be compiled by the Alliant FX/FORTRAN compiler running C under Alliant CONCENTRIX. It assumes the VAX FORTRAN file C has a file type of ".FOR" and puts the newly created source C file in a file of the same name but of type ".F" with the C job number appended after the ".F" for uniqueness in case C the user is running more that one job. Additionally, C it adds the "INCLUDE"ed files to the list of files C to be transferred to the Alliant FX/1 since they will be C necessary when the FORTRAN source code is recompiled C using the Alliant FX/FORTRAN compiler. C C INPUTS: C C IFILE - File Specification of the VAX FORTRAN file to C be converted C OFILE - File name of the VAX FORTRAN file to be converted. C Note this could be extracted from IFILE, however, C the calling routine had already done so. C JOBNUM - Job Number of the submitted job. Used to append C to the newly created fortran source file in case C the user is running more than one job at a time C OUTPUTS: C C None C C CALLED BY: C C VTU_LINK - VTU LINK Statement Converter C C CALLS TO: C C None C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*(*) IFILE, ! Input VAX FORTRAN filename * OFILE ! Output FX/FORTRAN filename C CHARACTER*1 JOBNUM, ! Input job number * NULL_STRING, ! Empty string * QUOTE, ! Single quote character * R_BRACK, ! Right square bracket character * SPACE, ! Single space character * TAB ! Horizontal tab character C CHARACTER*50 INCFILENAME, ! Filename in include statement * INCFILESPEC ! File specification in include C ! statement CHARACTER*74 WRITE_BUFFER ! Output buffer C CHARACTER*80 ILINE, ! Input card from VAX FORTRAN file * OLINE ! Output card to FX/FORTRAN file C LOGICAL CHAR_FLAG ! Flag denoting character found C ! preceding the "INCLUDE" statement INTEGER FIRST_QUOTE, ! First single quote in INCLUDE line * FOUND, ! Flag indicating whether a substring C ! was found in a string * SEC_QUOTE, ! Second single quote in INCLUDE line * RIGHT_BRACK, ! Location of right square bracket in C ! include if the bracket exists, 0 C ! otherwise * FXFILE, ! FX/FORTRAN file IO unit * VMSFILE ! VMS FORTRAN file IO unit C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA NULL_STRING /0/, * QUOTE /39/, ! Single quote = 39 decimal * R_BRACK /']'/, * SPACE /' '/, * TAB /9/, ! HT = 9 decimal * VMSFILE /7/, ! Fortran IO units 7 & 8 * FXFILE /8/ C C******************************************************************************* C C C****************************************************************************** C C Open the VMS FORTRAN input file. If err in input filename (i.e. C 'IFILE'.FOR can't be opened or does not exist), output error C message and exit. C C****************************************************************************** IFILE = IFILE(1:INDEX(IFILE,SPACE)-1)//'.FOR' OPEN(UNIT=VMSFILE,FILE=IFILE,READONLY,ACCESS='SEQUENTIAL', * STATUS='OLD',FORM='FORMATTED',ERR=40, * RECORDTYPE='VARIABLE') GO TO 50 40 WRITE(6,*)' ERROR OPENING ',IFILE GO TO 999 50 CONTINUE C****************************************************************************** C C Open the FX/FORTRAN output file. If error in output filename (i.e. C 'OFILE'.F can't be opened), output error message and exit. C C****************************************************************************** OFILE = OFILE(1:INDEX(OFILE,SPACE)-1)//'.F'//JOBNUM OPEN(UNIT=FXFILE,FILE=OFILE,ACCESS='SEQUENTIAL',STATUS='NEW', * FORM='FORMATTED',RECORDTYPE='VARIABLE',ERR=60) GO TO 70 60 CONTINUE WRITE(6,*)' ERROR OPENING ',OFILE GO TO 999 70 CONTINUE C****************************************************************************** C C Rewind both the input and output files C C****************************************************************************** REWIND VMSFILE REWIND FXFILE C****************************************************************************** C C Read a 80 character line from the VMS FORTRAN file C C****************************************************************************** 80 CONTINUE READ(VMSFILE,100,ERR=90,END=999)ILINE GO TO 110 ! INDICATES SUCCESSFUL READ C****************************************************************************** C C Case of unsuccessful read - Output error message to output file C C****************************************************************************** 90 CONTINUE WRITE(FXFILE,200) WRITE(FXFILE,300) GO TO 80 ! READ NEXT INPUT LINE C****************************************************************************** C C Successfile read case - Search line for INCLUDE substring C C****************************************************************************** 110 CONTINUE FOUND = INDEX(ILINE,'INCLUDE') IF (FOUND .EQ. 0) ! IF SUBSTRING NOT FOUND * THEN ! THEN C WRITE(FXFILE,100)ILINE ! OUTPUT LINE ELSE C****************************************************************************** C C Search the input line up to the "INCLUDE" statement looking for C characters. (i.e. check if the include statement is in a comment) C C****************************************************************************** CHAR_FLAG = .FALSE. DO I = 1,FOUND-1 ! FOR EVERY CHARACTER UP TO THE C ! "INCLUDE" IF (ILINE(I:I) .NE. SPACE .AND. ! IF NONBLANK OR NONTAB * ILINE(I:I) .NE. TAB) ! CHARACTER FOUND * THEN ! THEN WRITE(FXFILE,100)ILINE ! OUTPUT LINE CHAR_FLAG = .TRUE. ! SET THE CHARACTER FLAG GOTO 120 ! EXIT LOOP ENDIF ! ENDIF ENDDO ! ENDDO 120 CONTINUE C****************************************************************************** C C If the statement was a valid "INCLUDE" statement, then extract the C included filename from the included file specification, write the C new "INCLUDE" statement to the FX/FORTRAN output file. C C****************************************************************************** IF (.NOT.(CHAR_FLAG)) * THEN FIRST_QUOTE = INDEX(ILINE,QUOTE) + 1 SEC_QUOTE = FIRST_QUOTE + * INDEX(ILINE(FIRST_QUOTE+1:LEN(ILINE)),QUOTE) INCFILESPEC = ILINE(FIRST_QUOTE:SEC_QUOTE) RIGHT_BRACK = INDEX(INCFILESPEC,R_BRACK) INCFILENAME = INCFILESPEC IF (RIGHT_BRACK .NE. 0) * THEN INCFILENAME = * INCFILESPEC(RIGHT_BRACK+1:LEN(INCFILESPEC)) ENDIF WRITE_BUFFER = QUOTE// * INCFILENAME(1:INDEX(INCFILENAME,SPACE)) WRITE(FXFILE,400)WRITE_BUFFER C****************************************************************************** C C Write the "send" statement to the "FTPSEND'x'.COM" file thus C adding the "INCLUDE"ed file to the list of files to be C tranferred to the Alliant FX/1. C C****************************************************************************** WRITE_BUFFER = * INCFILESPEC(1:INDEX(INCFILESPEC,QUOTE)-1)// * SPACE//INCFILENAME(1:INDEX(INCFILENAME,QUOTE)-1) WRITE(FTPSENDUNIT,500)WRITE_BUFFER ENDIF ENDIF GOTO 80 999 CONTINUE C****************************************************************************** C C Close the VMS FORTRAN and FX/FORTRAN files C C****************************************************************************** CLOSE(UNIT=VMSFILE) CLOSE(UNIT=FXFILE) C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT(A80) 200 FORMAT(1X,'***** READ ERROR IN LINE *****') 300 FORMAT(1X,' ') 400 FORMAT(' INCLUDE ',A65) 500 FORMAT(' send ',A74) END SUBROUTINE VTU_COPY(DCL_RECORD) C******************************************************************************* C C TITLE: VTU COPY Statement Conversion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This routine converts the VMS DCL "COPY" command C to the equivalent "cp" command of 4.2 BSD Unix and C outputs the built Unix command to the C Shell command C script being constructed. The file specifications are C converted from VMS to Unix specifications, including C the conversion to lower case and any necessary variable C substition in the filenames. Since the VMS "COPY" C command in a DCL file implies IO file input, the file C specification of the file being copied is added to the C list of files that is transferred to the Alliant FX/1. C Additionally, if the "COPY" statement is to a FORTRAN C IO channel, (i.e. FORxxx, where xxx = 0,1,...99), and C the filename of the copied file is in the GET LIST C global array indicating that an "ASSIGN" statement has C previously been encountered for the particular file, C the filename is part of an (ASSIGN,COPY) command pair, C and thus indicates a file that is an input file. The C filename is therefore removed from the GET LIST global C array to prevent it from being assigned to the file C retrieve list. C C INPUTS: C C DCL_RECORD - Input card containing DCL "COPY" command C C OUTPUTS: C C None C C CALLED BY: C C VTU_PARSE - Command Line Parser C C CALLS TO: C C VTU_GETFILE - Returns next VMS file specification from C specified character string C VTU_VAR_EXP - Returns variable value and equivalent Unix C variable string for DCL variables character C strings C VTU_VAR_INS - Replaces a variable in a character string C with specified character string C VTU_FSCON - Converts file specifications from VMS to C Unix C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C IO file arrays containing symbolic or logical equivalents of C names of files comprising FTP GET list and their actual or C physical file names C COMMON /GET_LIST/ LO_FILES(100), * PHY_FILES(100) C CHARACTER*64 LO_FILES, * PHY_FILES C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 DOLLAR_SIGN, ! Dollar sign character * DOT, ! Period or dot character * QUOTE, ! Single quote character * R_BRACK, ! Right square bracket character * SLASH, ! Forward slash character * SPACE ! Space character C CHARACTER*3 DAT, ! "DAT" file type extension * FILETYPE, ! VMS file type * FORSPEC ! "FOR" of "FORxxx" Fortran IO C ! unit specifier C CHARACTER*13 UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " CHARACTER*32 VAR_VALUE(2) ! DCL variable values CHARACTER*64 SENDFILE, ! Filename that the file will have C ! on Alliant FX/1 after transfer * UNIXFILE(2), ! Unix equivalent of VMS file C ! specification * VMSFILE(2) ! VMS file specification C CHARACTER*80 DCL_RECORD, ! Input DCL command card * WRITE_BUFFER ! Output buffer C INTEGER FOR_CHAN, ! Integer value of "xxx" in "FORxxx" C ! Fortran IO unit specification * LOWERCASE ! Change to lowercase indicator C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA DAT /'DAT'/, * DOLLAR_SIGN /'$'/, * DOT /'.'/, * FORSPEC /'FOR'/, * LOWERCASE /1/, * QUOTE /39/, ! ASCII(Single quote) = 39 decimal * R_BRACK /']'/, * SLASH /'/'/, * SPACE /' '/ C C******************************************************************************* C C C******************************************************************************* C C The "COPY" command will have two file specifications as C arguments. Get the two file specifications and check if they C contain DCL variables. If they contain DCL variables insert C equivalent Unix string to evaluate the variable into the C file specification name. Convert each file specification to C the corresponding specification for a Unix file. C C******************************************************************************* C DO I = 1,2 DCL_RECORD = * DCL_RECORD(INDEX(DCL_RECORD,SPACE)+1:LEN(DCL_RECORD)) CALL VTU_GETFILE(DCL_RECORD,VMSFILE(I)) IF (INDEX(VMSFILE(I),QUOTE) .EQ. 0) * THEN UNIXFILE(I) = VMSFILE(I) ELSE CALL VTU_VAR_EXP(VMSFILE(I),VAR_VALUE(I),UNIX_STR) CALL VTU_CHCASE(UNIX_STR,UNIX_STR,LOWERCASE) CALL VTU_VAR_INS(VMSFILE(I),UNIX_STR,UNIXFILE(I)) ENDIF CALL VTU_FSCON(UNIXFILE(I),UNIXFILE(I)) ENDDO C******************************************************************************* C C Insert the variable value into the first VMS file specification C and construct the filename that the file will have on the Alliant C FX/1 after it is transferred. If no variable exists in the first C VMS file specification, a null string is inserted, thus not C affecting it. C C******************************************************************************* CALL VTU_VAR_INS(VMSFILE(1),VAR_VALUE(1),VMSFILE(1)) CALL VTU_FSCON(VMSFILE(1),SENDFILE) C******************************************************************************* C C If the second VMS file specification in the COPY command is a C Fortran IO specification, blank out the corresponding logical C (unexpanded DCL variables) filename in the GET LIST global C arrays since an (ASSIGN,COPY) pair indicates an input file and C the file should be sent to the Alliant FX/1 and not retrieved. C Additionally, assign the second Unix file name to the Fortran C IO unit specifier preceded by a dollar sign character "$FORxxx" C as this is the way Unix expects such specifiers. C C******************************************************************************* IF (VMSFILE(2)(1:3) .EQ. FORSPEC) * THEN DECODE(2,100,VMSFILE(2)(5:6))FOR_CHAN LO_FILES(FOR_CHAN+1) = SPACE UNIXFILE(2) = DOLLAR_SIGN//VMSFILE(2) ELSE C******************************************************************************* C C Since the second VMS file wasn't a Fortran IO unit specifier, C add a file type of ".DAT" to the second Unix file specification if C the VMS second file specification has no type, convert the second C Unix file specification to lowercase. C C******************************************************************************* IF (INDEX(UNIXFILE(2),DOT) .EQ. 0) * THEN UNIXFILE(2) = * UNIXFILE(2)(1:INDEX(UNIXFILE(2),SPACE)-1)//DOT//DAT ELSE FILETYPE = * UNIXFILE(2)(INDEX(UNIXFILE(2),DOT)+1: * INDEX(UNIXFILE(2),DOT)+3) IF (FILETYPE(1:1) .EQ. SPACE) * THEN UNIXFILE(2) = * UNIXFILE(2)(1:INDEX(UNIXFILE(2),SPACE)-1)// * DOT//DAT ENDIF ENDIF CALL VTU_CHCASE(UNIXFILE(2),UNIXFILE(2),LOWERCASE) C******************************************************************************* C C Remove any logical files from the GET LIST global array data C that correspond to the second VMS file as we have discovered an C (ASSIGN,COPY) pair as mentioned above. C C******************************************************************************* DO FOR_CHAN = 1,100 IF (LO_FILES(FOR_CHAN) .EQ. VMSFILE(2) .OR. * LO_FILES(FOR_CHAN) .EQ. * VMSFILE(2)(1:INDEX(VMSFILE(2),SPACE)-1)//DOT//DAT) * THEN LO_FILES(FOR_CHAN) = SPACE ENDIF ENDDO ENDIF C******************************************************************************* C C Output the "send" command to the list of files to be send that C is being constructed as: C C send vmsfile1 sendfile C C where "vmsfile1" is the file specification specified in the COPY C statement after variable expansion, and the "sendfile" is the C corresponding Unix file specification constructed above. C C Output the constructed "cp" command to the C Shell command script C being constructed in the following format: C C cp unixfile1 unixfile2 C C where "unixfile1" is always a file specification, but "unixfile2" C is either a Unix file specification or a "$FORxxx" denoting a C Fortran IO unit. C C******************************************************************************* WRITE_BUFFER = * VMSFILE(1)(1:INDEX(VMSFILE(1),SPACE))//SENDFILE WRITE(FTPSENDUNIT,200)WRITE_BUFFER WRITE_BUFFER = * UNIXFILE(1)(1:INDEX(UNIXFILE(1),SPACE))//UNIXFILE(2) WRITE(CSCRIPTUNIT,300)WRITE_BUFFER RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT(I2) 200 FORMAT(' send ',A74) 300 FORMAT('cp ',A76) END SUBROUTINE VTU_CREATE(DCL_RECORD,EOFNUMBER) C******************************************************************************* C C TITLE: VTU CREATE Statement Conversion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This routine converts the VMS DCL "CREATE" command C to the equivalent "cat" command of 4.2 BSD Unix and C outputs the built Unix command to the C Script command C file being constructed. The file specification is C converted from a VMS to Unix specification, including C the conversion to lower case and any necessary variable C substition in the filename. C C INPUTS: C C DCL_RECORD - Input card containing DCL "CREATE" command C EOFNUMBER - Number of current CREATE command found used C to construct unique EOF label in "cat" C command C C OUTPUTS: C C EOFNUMBER - Incremented value of input EOFNUMBER C C CALLED BY: C C VTU_PARSE - Command Line Parser C C CALLS TO: C C VTU_GETFILE - Returns next VMS file specification from C specified character string C VTU_VAR_EXP - Returns variable value and equivalent Unix C variable string for DCL variables character C strings C VTU_VAR_INS - Replaces a variable in a character string C with specified character string C VTU_FSCON - Converts file specifications from VMS to C Unix C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 DOLLAR_SIGN, ! Dollar sign character * EOFNUM, ! Character equivalent of EOFNUMBER * LT_SIGN, ! Less than sign character * QUOTE, ! Single quote character * SPACE ! Space character C CHARACTER*3 EOF ! End of file "eof" characters C CHARACTER*13 UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " CHARACTER*32 VAR_VALUE ! DCL variable value CHARACTER*64 UNIXFILE, ! Unix equivalent of VMS file C ! specification * VMSFILE ! VMS file specification CHARACTER*80 DCL_RECORD, ! Input DCL command card * WRITE_BUFFER ! Output buffer C INTEGER EOFNUMBER ! Input number of CREATE command C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA DOLLAR_SIGN /'$'/, * EOF /'eof'/, * LOWERCASE /1/, * LT_SIGN /'<'/, * QUOTE /39/, ! ASCII(Single quote) = 39 decimal * SPACE /' '/ C C******************************************************************************* C C******************************************************************************* C C The "CREATE" command will have one file specification as it's C argument. Get the file specification and check if it contains C a DCL variable. If it contains a DCL variable insert the C equivalent Unix string to evaluate the variable into the C file specification name. Convert the file specification to C the corresponding specification for a Unix file and convert C it to lowercase. C C******************************************************************************* C DCL_RECORD = * DCL_RECORD(INDEX(DCL_RECORD,SPACE)+1:LEN(DCL_RECORD)) CALL VTU_GETFILE(DCL_RECORD,VMSFILE) IF (INDEX(VMSFILE,QUOTE) .NE. 0) * THEN CALL VTU_VAR_EXP(VMSFILE,VAR_VALUE,UNIX_STR) CALL VTU_VAR_INS(VMSFILE,UNIX_STR,VMSFILE) ENDIF CALL VTU_FSCON(VMSFILE,UNIXFILE) CALL VTU_CHCASE(UNIXFILE,UNIXFILE,LOWERCASE) C******************************************************************************* C C Convert the CREATE number used in the EOF specifier to C character, construct the argument list to the "cat" command C in the output buffer and output the Unix "cat" command that C corresponds to the DCL "CREATE" command according to the C following form: C C cat > unixfile << 'eofx' C C where x, the number of the CREATE command is one of 0,1,...9. C The " << 'eofx' " denotes the use of inline data up to the C 'eofx' is to be put in "unixfile". C C******************************************************************************* ENCODE(1,100,EOFNUM)EOFNUMBER WRITE_BUFFER = * UNIXFILE(1:INDEX(UNIXFILE,SPACE))//LT_SIGN//LT_SIGN// * SPACE//QUOTE//EOF//EOFNUM//QUOTE WRITE(CSCRIPTUNIT,200)WRITE_BUFFER C******************************************************************************* C C Read the inline data cards and write them to the C Shell command C script being constructed until a the next valid DCL statement C is found. C C******************************************************************************* 10 CONTINUE READ(VAXDCLUNIT,300)DCL_RECORD IF (INDEX(DCL_RECORD,DOLLAR_SIGN) .EQ. 0) * THEN WRITE(CSCRIPTUNIT,300)DCL_RECORD GOTO 10 ELSE C******************************************************************************* C C When a valid DCL statement is found, output the inline data C terminator, namely, 'eofx' , to the C Shell command script C being constructed where 'eofx' is as described above. The 'eofx' C must be in column 1 of the command script. Increment the CREATE C command number for the next CREATE command. C C******************************************************************************* WRITE(CSCRIPTUNIT,400)QUOTE,EOFNUMBER,QUOTE EOFNUMBER = EOFNUMBER + 1 ENDIF RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT(I1) 200 FORMAT('cat > ',A74) 300 FORMAT(A80) 400 FORMAT(A1,'eof',I1,A1) END SUBROUTINE VTU_DELETE(DCL_RECORD) C******************************************************************************* C C TITLE: VTU DELETE Statement Conversion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This routine converts the VMS DCL "DELETE" command C to the equivalent "rm" command of 4.2 BSD Unix and C outputs the built Unix command to the C Shell command C script being constructed. The file specification is C converted from a VMS to a Unix specification, including C the conversion to lower case and any necessary variable C substition in the filename. C C INPUTS: C C DCL_RECORD - Input card containing DCL "DELETE" command C C OUTPUTS: C C None C C CALLED BY: C C VTU_PARSE - Command Line Parser C C CALLS TO: C C VTU_GETFILE - Returns next VMS file specification from C specified character string C VTU_VAR_EXP - Returns variable value and equivalent Unix C variable string for DCL variables character C strings C VTU_VAR_INS - Replaces a variable in a character string C with specified character string C VTU_FSCON - Converts file specifications from VMS to C Unix C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 QUOTE, ! Single quote character * SPACE ! Space character CHARACTER*13 UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " CHARACTER*32 VAR_VALUE ! DCL variable value CHARACTER*64 UNIXFILE, ! Unix equivalent of VMS file C ! specification * VMSFILE ! VMS file specification CHARACTER*80 DCL_RECORD ! Input DCL command card INTEGER FSLEN, ! File Specification LENgth * FSLOC, ! File Specification LOCation * LOWERCASE ! Change to lowercase indicator C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA LOWERCASE /1/, * QUOTE /39/, ! ASCII(single quote) = 39 decimal * SPACE /' '/ C C******************************************************************************* C C C******************************************************************************* C C The "DELETE" command will have one argument, however it may C contain multiple file specifications to be deleted and may C contain wildcard characters. For each file specification C check if it contains DCL variables and if so, insert the C equivalent Unix string to evaluate the variable into the file C specification on the Alliant FX/1. Convert each VMS file C specification to a Unix file specification and convert it to C lowercase. Output a "rm" statement for each file specification C found in the "DELETE" statement. Wildcards are unaffected and C appear in the "rm" statement correctly. For a DCL "DELETE" C command of the form: C C DELETE vmsfile1,vmsfile2,.....vmsfile(n) C C the "rm" statement(s) constructed takes the following form: C C rm unixfile1 C rm unixfile2 C . C . C rm unixfile(n) C C******************************************************************************* C DCL_RECORD = * DCL_RECORD(INDEX(DCL_RECORD,SPACE)+1:LEN(DCL_RECORD)) DO WHILE (DCL_RECORD(1:1) .NE. SPACE) CALL VTU_GETFILE(DCL_RECORD,VMSFILE) IF (INDEX(VMSFILE,QUOTE) .NE. 0) * THEN CALL VTU_VAR_EXP(VMSFILE,VAR_VALUE,UNIX_STR) CALL VTU_VAR_INS(VMSFILE,UNIX_STR,VMSFILE) ENDIF CALL VTU_FSCON(VMSFILE,UNIXFILE) CALL VTU_CHCASE(UNIXFILE,UNIXFILE,LOWERCASE) WRITE(CSCRIPTUNIT,100)UNIXFILE C******************************************************************************* C C Get the remainder of the DCL "DELETE" command argument C C******************************************************************************* FSLOC = * INDEX(DCL_RECORD,VMSFILE(1:INDEX(VMSFILE,SPACE)-1)) FSLEN = INDEX(VMSFILE,SPACE) DCL_RECORD = * DCL_RECORD(FSLOC+FSLEN:LEN(DCL_RECORD)) ENDDO RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT('rm ',A32) END SUBROUTINE VTU_EOF(JOBNUM) C******************************************************************************* C C TITLE: VTU End Of File Processing C AUTHOR: Glen D. West C DATE: August, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This routine does all post-processing necessary C after the end of the DCL command file is reached. C It outputs file cleanup commands and the "touch" C command to the C Shell Script file being constructed. C The "touch" command will create a file at the end C of the job to tell the FX/1 batch daemon that the C job has completed. This routine also outputs the C filenames in the GET LIST global arrays to the file C containing the list of files to be retrieved from C the FX/1 after the job completes. Finally, the C C Shell Script file constructed is added to the file C containing the list of files to be sent to the FX/1, C and commands to exit the FTP utility are added to C both the files containing the lists of files to send C and get from the FX/1. C C INPUTS: C C JOBNUM - Job Number of the submitted job. Used to append C to the newly created fortran source file in case C the user is running more than one job at a time C C OUTPUTS: C C None C C CALLED BY: C C VTU_PARSE - Command Line Parser C C CALLS TO: C C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C IO file arrays containing symbolic or logical equivalents of C names of files comprising FTP GET list and their actual or C physical file names C COMMON /GET_LIST/ LO_FILES(100), * PHY_FILES(100) C CHARACTER*64 LO_FILES, * PHY_FILES C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 JOBNUM, ! Number of the job * NULL_STRING, ! Empty string character * SPACE, ! Single space character * USCORE ! Underscore character C CHARACTER*3 FX1 ! "FX1" character string C CHARACTER*64 GETFILE ! File to retrieve from FX/1 C CHARACTER*80 WRITE_BUFFER ! Output buffer C INTEGER FOR_CHAN, ! Fortran IO channel * LOWERCASE ! Change to lowercase indicator C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA FX1 /'FX1'/, * LOWERCASE /1/, * NULL_STRING /0/, ! ASCII(null_string) = decimal 0 * SPACE /' '/, * USCORE /'_'/ C C******************************************************************************* C C C******************************************************************************* C C Output the file cleanup commands to the C Shell Script file being C constructed. Walk through the list of files in the global GET LIST C arrays converting each filename in the array to lower case C and writing a "get" command for each file to the file containing C the list of files to retrieve from the FX/1. C C******************************************************************************* WRITE(CSCRIPTUNIT,100)JOBNUM DO FOR_CHAN = 1,100 IF (LO_FILES(FOR_CHAN)(1:1) .NE. SPACE .AND. * LO_FILES(FOR_CHAN)(1:1) .NE. NULL_STRING) * THEN CALL VTU_CHCASE(PHY_FILES(FOR_CHAN),GETFILE, * LOWERCASE) WRITE_BUFFER = * GETFILE(1:INDEX(GETFILE,SPACE))// * FX1//USCORE//GETFILE WRITE(FTPGETUNIT,200)WRITE_BUFFER,GETFILE ENDIF ENDDO C******************************************************************************* C C Output commands to send the C Shell Script file constructed and C terminate the FTP utility to the file containing the list of C files to be sent to the FX/1. Output commands to cleanup files C and terminate the FTP utility to the file containing the list of C files to retrieve from the FX/1. Finally, close all Fortran IO C channels that are being used. C C******************************************************************************* WRITE(FTPSENDUNIT,300)JOBNUM WRITE(FTPGETUNIT,400) C CLOSE (VAXDCLUNIT) CLOSE (CSCRIPTUNIT) CLOSE (FTPSENDUNIT) CLOSE (FTPGETUNIT) C RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT('rm *.DAT >>& /dev/null',/, * 'rm *.CMN >>& /dev/null',/, * 'rm *.f >>& /dev/null',/, * 'rm *.o >>& /dev/null',/, * 'rm *.olb >>& /dev/null',/, * 'touch batch_done',A1) 200 FORMAT(' get ',A75,/,' delete ',A64) 300 FORMAT(' send batscript',A1,'.com',/, * ' bye') 400 FORMAT(' mdel *',/, * ' bye') END SUBROUTINE VTU_FSCON(VMSFILE,UNIXFILE) C******************************************************************************* C C TITLE: VTU File Specification CONversion utility C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This utility converts a VMS file specification to a C BSD 4.2 Unix file specification. This routine does not C handle DECNET node specifications in input VMS file C specifications as we do not have DECNET and all C user files are on a single VAX node. In addition, C devices and directory names are not returned in the C Unix file specification as they would not be the same C on another machine. Since Unix does not use the concept C of file versions, the version number is also omitted in C the Unix file specification returned. C C C INPUTS: C C VMSFILE - VMS File specification in the form: C C device : [ directory ] filename . filetype ; version C C OUTPUTS: C C UNIXFILE - Equivalent BSD 4.2 Unix file specification C in the form: C C filename . filetype C C C CALLED BY: C C Numerous routines C C CALLS TO: C C VTU_VMSFSB - VTU VMS File Specification Breakdown utility C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 DOT, ! Period or dot character * NOT_USED, ! Dummy subroutine argument * SPACE ! Single space character CHARACTER*39 UNIXFILENAME, ! Unix filename * UNIXFILETYPE ! Unix filetype CHARACTER*(*) UNIXFILE, ! Unix equivalent of VMS file C ! specification * VMSFILE ! VMS file specification C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA DOT /'.'/, * SPACE /' '/ C C******************************************************************************* C C C******************************************************************************* C C Send the VMS file specification the the VMS file specification C breakdown utility and receive the Unix file name and type C back. Use dummy arguments for the device, directory and version C arguments as we do not need these. Append the Unix file type to C the Unix file name if the file type exists, separating them with C a dot. C C******************************************************************************* CALL VTU_VMSFSB(VMSFILE,NOT_USED,NOT_USED,UNIXFILENAME, * UNIXFILETYPE,NOT_USED) UNIXFILE = UNIXFILENAME IF (UNIXFILETYPE(1:1) .NE. SPACE) * THEN UNIXFILE = * UNIXFILENAME(1:INDEX(UNIXFILENAME,SPACE)-1)// * DOT//UNIXFILETYPE ENDIF RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C None C C******************************************************************************* C END SUBROUTINE VTU_GETFILE(FILELIST,FILENAME) C******************************************************************************* C C TITLE: VTU GET next FILEname C AUTHOR: Glen D. West C DATE: October, 1986 C LANG: VAX FORTRAN C C PURPOSE: C This utility returns the next file specification C from the input file list. It assumes these lists C are portions of DCL commands and that the file C specifications are therefore separated by either C spaces, commas, and/or plus-signs. It currently C treats anything enclosed in parentheses as a single C file specification. C C INPUTS: C C FILELIST - String containing list of files C C OUTPUTS: C C FILENAME - Next file specification in the list C C CALLED BY: C C Numerous routines C C CALLS TO: C C None C C******************************************************************************* C C GLOBALS: C C None C C******************************************************************************* C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*(*) FILELIST, ! Input list of files * FILENAME ! Output next file specification C ! in the list C CHARACTER*1 COMMA, ! Comma character * LEFT_PAREN, ! Left parenthesis character * NULL_STRING, ! Empty string character * PLUS_SIGN, ! Plus sign character * RIGHT_PAREN, ! Right parenthesis character * SPACE ! Single space character C INTEGER PARENS, ! Parentheses counter * POINTER ! Pointer into file list string LOGICAL END_OF_NAME ! TRUE when end of the file list C ! found, FALSE otherwise C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA COMMA /','/, * LEFT_PAREN /'('/, * NULL_STRING /0/, ! ASCII(null string) = decimal 0 * PLUS_SIGN /'+'/, * RIGHT_PAREN /')'/, * SPACE /' '/ C C******************************************************************************* C C C******************************************************************************* C C Initialize variables and shift off leading spaces in the C file list. C C******************************************************************************* C END_OF_NAME = .FALSE. FILENAME = NULL_STRING POINTER = 1 DO WHILE (POINTER .LT. 80 .AND. * FILELIST(POINTER:POINTER) .EQ. SPACE) FILELIST(POINTER:LEN(FILELIST)) = * FILELIST(POINTER+1:LEN(FILELIST)) POINTER = POINTER + 1 ENDDO C******************************************************************************* C C Walk through the file list string until a file specification C termination character is found which is one of (SPACE,COMMA, C PLUS SIGN). Ensure the everything in parentheses is treated C as a single entity by counting left and right parens. C C******************************************************************************* POINTER = 0 DO WHILE (POINTER .LT. LEN(FILELIST) .AND. * .NOT. (END_OF_NAME)) POINTER = POINTER + 1 IF (FILELIST(POINTER:POINTER) .EQ. LEFT_PAREN) * THEN PARENS = PARENS + 1 ELSE IF (FILELIST(POINTER:POINTER) .EQ. RIGHT_PAREN) * THEN PARENS = PARENS - 1 ENDIF ENDIF IF (PARENS .EQ. 0) * THEN IF (FILELIST(POINTER:POINTER) .EQ. SPACE .OR. * FILELIST(POINTER:POINTER) .EQ. COMMA .OR. * FILELIST(POINTER:POINTER) .EQ. PLUS_SIGN) * THEN END_OF_NAME = .TRUE. ENDIF ENDIF ENDDO C******************************************************************************* C C As long as a file specification was found, i.e. the pointer C didn't go all the way to the end of the list, extract the C filename out of the file list using the pointer which points C to the file specification termination character. C C******************************************************************************* IF (POINTER .LT. LEN(FILELIST)) * THEN FILENAME = FILELIST(1:POINTER-1) ENDIF RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C None C C******************************************************************************* C END SUBROUTINE VTU_INIT(VAXDCLFILE,JOBNUM) C******************************************************************************* C C TITLE: VTU Initialization C AUTHOR: Glen D. West C DATE: August, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This routine opens the Fortran IO channels to C the input DCL command file, the output C Shell C Script file to be constructed and the output C files containing the FTP commands to send and C retrieve the necessary files from the FX/1. It C then outputs the FTP commands to these FTP C command files to login in to the FX/1 and set C the current directory, outputs the FTP commands C to retrieve the job log file, and outputs commands C to the C Shell Script file to declare some BEWSS C only logical variables, and to set the current C directory during script execution. It also outputs C a "#" as the first character in the C Shell Script C to keep Concentrix from using the Bourne Script. C C INPUTS: C C VAXDCLFILE - Name of the VAX DCL command file C JOBNUM - Number of the job C C OUTPUTS: C C None C C CALLED BY: C C VTU_MAIN - VTU main processing routine C C CALLS TO: C None C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 JOBNUM, ! Number of the job * QUOTE ! Single quote character C CHARACTER*32 FILENAME, ! Filename of file to open * VAXDCLFILE ! Input VMS DCL command file C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA QUOTE /39/ ! ASCII(single quote) = decimal 39 C C******************************************************************************* C C C******************************************************************************* C C Open the VMS DCL input file, the Unix C Shell Script output file, C the file that will be used by the FTP utility to SEND files to C the Alliant FX/1 and the file that will be used by the FTP utility C to GET files from the Alliant FX/1. C C******************************************************************************* C FILENAME = VAXDCLFILE OPEN(UNIT=VAXDCLUNIT,FILE=FILENAME,DEFAULTFILE='.COM',READONLY, * ACCESS='SEQUENTIAL',STATUS='OLD',FORM='FORMATTED', * ERR=100,RECORDTYPE='VARIABLE') FILENAME = 'BATSCRIPT'//JOBNUM//'.COM' OPEN(UNIT=CSCRIPTUNIT,FILE=FILENAME,ACCESS='SEQUENTIAL', * STATUS='NEW',FORM='FORMATTED',ERR=100, * RECORDTYPE='VARIABLE') FILENAME = 'FTPSEND'//JOBNUM//'.COM' OPEN(UNIT=FTPSENDUNIT,FILE=FILENAME,ACCESS='SEQUENTIAL', * STATUS='NEW',FORM='FORMATTED',ERR=100, * RECORDTYPE='VARIABLE') FILENAME = 'FTPGET'//JOBNUM//'.COM' OPEN(UNIT=FTPGETUNIT,FILE=FILENAME,ACCESS='SEQUENTIAL', * STATUS='NEW',FORM='FORMATTED',ERR=100, * RECORDTYPE='VARIABLE') C******************************************************************************* C C Output FTP commands to the SEND and GET FTP command files to C login to the FX/1 and set the current directory. Output commands C to te GET file to retrieve and delete the job log file from the C FX/1. Output commands to the C Shell Script file to declare the C file a C Shell Script as opposed to a Bourne Shell Script, turn C the command echo on, set certain logical variables necessary for C the BEWSS simulation file specifications and set the current C directory for the script to the correct batch subdirectory on C the FX/1. This subdirectory is given by: C C /users/batch/batch'x' C C where 'x' = 0,1,..5 is the job number. C C******************************************************************************* C WRITE(FTPSENDUNIT,300)JOBNUM WRITE(FTPGETUNIT,300)JOBNUM WRITE(FTPGETUNIT,400)JOBNUM,JOBNUM WRITE(CSCRIPTUNIT,500)QUOTE,JOBNUM,QUOTE, * QUOTE,JOBNUM,JOBNUM,QUOTE,JOBNUM GOTO 200 100 CONTINUE WRITE(6,*)' ERROR OPENING ',FILENAME 200 CONTINUE RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 300 FORMAT(' user batch hidden',/, * ' cd batch',A1) 400 FORMAT(' get vax_batch',A1,'.log',/, * ' delete vax_batch',A1,'.log') 500 FORMAT('#',/, * 'set echo',/, * 'set w = ',A1,'/users/batch/batch',A1,'/',A1,/, * 'set wpid = ',A1,'/users/batch/batch',A1,'/bewss',A1,A1,/, * 'cd /users/batch/batch',A1) END LOGICAL FUNCTION VTU_IN_STRING(THE_STRING,THE_SUBSTRING) C******************************************************************************* C C TITLE: VTU IN STRING logical function C AUTHOR: Glen D. West C DATE: February, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This logical function returns TRUE if the input C substring is found in the input string and FALSE C otherwise. C C INPUTS: C THE_STRING - The string to be searched C THE_SUBSTRING - The substring to be searched for C C OUTPUTS: C C IN_STRING - Logical value of the function C C CALLED BY: C C VTU_MAIN - VTU main processing routine C VTU_PARSE - Command line parser C C CALLS TO: C C None C C******************************************************************************* C C GLOBALS: C C None C C******************************************************************************* C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*(*) THE_STRING, ! The input string to be searched * THE_SUBSTRING ! The input substring to be searched C ! for C INTEGER FOUND ! Holds location of substring in string C ! if it was found and 0 otherwise C C******************************************************************************* C C DATA: C C None C C******************************************************************************* C C C******************************************************************************* C C Search the string for the substring, set the return value of C the function to TRUE if the substring is found and FALSE C otherwise. Note: the INDEX function returns 0 when the substring C is not found. C C******************************************************************************* C FOUND = INDEX(THE_STRING,THE_SUBSTRING) IF (FOUND .NE. 0) * THEN VTU_IN_STRING = .TRUE. ELSE VTU_IN_STRING = .FALSE. ENDIF RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C END SUBROUTINE VTU_LINK(DCL_RECORD,JOBNUM) C******************************************************************************* C C TITLE: VTU LINK statement conversion C AUTHOR: Glen D. West C DATE: October, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This routine converts the VAX/VMS DCL "LINK" command C of the form: C C LINK [/EXE = execfile ] filespec(1) + filespec(2) + ... C filespec(n) C C where: C filespec(i) may be either an object file specification C or a object module library file specification. Library file C specifications may also optionally contain the "/INC or C /INCLUDE" qualifier to denote that certain files should be C explicity linked out of to object module library. All other C DCL LINK statement parameters and argument qualifiers are C currently ignored. C The LINK command is translated into the a series of C C Script commands. A routine is invoked to convert the source C code of each of filespec(1)...filespec(n) from VAX FORTRAN C to FX/FORTRAN and transferred to the FX/1. It must be C recompiled on the FX/1 with: C C fortran -c filespec(1).f C . C . C fortran -c filespec(n).f C C Copies of the object module library files are assumed to C already exist on the FX/1 in the /users/batch/vaxlibs C directory. Each of the library files in the LINK statement C must be copied over and randomized with: C C cp ../vaxlibs/libfile(1).olb libfile(1).olb C ranlib libfile(1).olb C . C . C cp ../vaxlibs/libfile(n).olb libfile(n).olb C ranlib libfile(2).olb C C This is done rather than linking from these libraries C directly because multiple jobs linking simultaneously would C try to access the libraries simultaneously and it prevents C any possible corruption of the good copy of the library C file by the linker. C Each filespec whether object or library is added in order C to a list of files to be linked in. Explicity linked files from C object libraries specified by the "/INC" qualifier are added C to the list before there corresponding library. The FX/1 link C command is then constructed as: C C fortran -t -o execfile / C filespec(1).o / C . C . C filespec(n).o / C libfile(1).olb / C . C . C libfile(n).olb / C -lvax C where: C - t indicates a link trace C / indicates continuation onto the next line C -lvax indicates to link in the VAX FORTRAN function C library. C C Each of the libfile(n).olb files will be preceded in the C by explicity linked files. For example the following object C module: C libfile(i)/INC=( file(1)....file(n) ) C C in the LINK statement would yield: C C file(1).o / C . C . C file(2).o / C libfile(i).olb / C C The routine that is invoked to convert the source code from C VAX FORTRAN to FX/FORTRAN also generates the FTP commands to C tranfer the source code files and the files they INCLUDE to C the FX/1. C C INPUTS: C C DCL_RECORD - Input card containing DCL "LINK" command C JOBNUM - Number of the job C C OUTPUTS: C C None C C CALLED BY: C C VTU_PARSE - Command Line Parser C C CALLS TO: C C VTU_GETFILE - Returns next VMS file specification from C specified character string C VTU_VAR_EXP - Returns variable value and equivalent Unix C variable string for DCL variables character C strings C VTU_VAR_INS - Replaces a variable in a character string C with specified character string C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C VTU_COMPRESS - Compresses multiple spaces into single spaces C for a string C VTU_VMSFSB - VMS file specification breakdown routine C VTU_CONSC - Converts VAX FORTRAN source code to FX/FORTRAN C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 NOT_USED ! Dummy subroutine argument C CHARACTER*1 B_SLASH, ! Back slash character * COMMA, ! Comma character * DOT, ! Period or dot character * EQ_SIGN, ! Equals sign character * HYPHEN, ! Hyphen character * JOBNUM, ! Number of the job * LEFT_PAREN, ! Left parenthesis character * LT_SIGN, ! Less Than Sign character * NULL_STRING, ! Empty string character * O, ! Lowercase O character * QUOTE, ! Single quote character * R_BRACK, ! Right square bracket character * RIGHT_PAREN, ! Right parenthesis character * SLASH, ! Regular slash character * SPACE, ! Single space character * STAR, ! Asterisk character * USCORE ! Underscore character C CHARACTER*2 DOT_BF, ! Dot followed by "F" * DOT_LF ! Dot followed by "f" C CHARACTER*4 EXE_PAR, ! "/EXE" VAX link command parameter * INC_PAR, ! "/INC" VAX link argument qualifier * LIB_PAR, ! "/LIB" VAX link argument qualifier * OLB ! ".olb" character string C CHARACTER*6 LVAX ! "-lvax" FX/1 linker argument C C CHARACTER*13 OBJECT, ! "../vaxobject/" directory C ! specification * UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " C CHARACTER*39 EXECFILE, ! Name of executable image file * INCFILE, ! Name of file being explicity C ! linked from the library * LIBFILE, ! Name of the library file * UNIXFILE, ! Unix equivalent of the VMS file C ! specification * VMSFILE ! VMS file name C CHARACTER*43 LINK_LIST(100) ! List of arguments to put on FX/1 C ! linker command CHARACTER*64 DIRSPEC, ! VMS directory specification * FILESPEC, ! VMS file specification * VAR_VALUE ! DCL variable value C CHARACTER*80 DCL_RECORD, ! Input DCL command line * INCLIST, ! List of file names explicity INCLUDED C ! from a particular library file * REST_OF_LINE, ! Remaining substring of DCL line * WRITE_BUFFER ! Output buffer C INTEGER FSLEN, ! File Specification length * FSLOC, ! File Specification location * INC_LOC, ! Location of "/INC" * LINK_PNTR, ! Pointer to next available space C ! in list of FX/1 link arguments * LOWERCASE, ! Change to lowercase indicator * NEXT_FILE ! C LOGICAL END_OF_LINE, ! TRUE when end of DCL line found, C ! FALSE otherwise * END_OF_LINK, ! TRUE when end of VMS LINK command C ! found, FALSE otherwise * LASTLINE, ! TRUE when last line of VMS LINK C ! command found, FALSE otherwise * LIB_CODE, ! TRUE when LINK statement contains a C ! library filename, FALSE otherwise * NEW_OBJ_CODE ! TRUE when LINK statement contains an C ! object code filename, FALSE otherwise C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA B_SLASH /'\'/, * COMMA /','/, * DOT /'.'/, * DOT_BF /'.F'/, * DOT_LF /'.f'/, * EOL /'eol'/, * EQ_SIGN /'='/, * EXE_PAR /'/EXE'/, * HYPHEN /'-'/, * INC_PAR /'/INC'/, * LIB_PAR /'/LIB'/, * LEFT_PAREN /'('/, * LOWERCASE /1/, * LT_SIGN /'<'/, * LVAX /' -lvax'/, * NULL_STRING /0/, ! ASCII(null string) = decimal 0 * O /'o'/, * OBJECT /'../vaxobject/'/, * OLB /'.olb'/, * QUOTE /39/, ! ASCII(single quote) = decimal 39 * R_BRACK /']'/, * RIGHT_PAREN /')'/, * SLASH /47/, ! ASCII(slash) = decimal 47 * SPACE /' '/, * STAR /'*'/, * USCORE /'_'/ C C******************************************************************************* C C C******************************************************************************* C C Initialize flags and pointers. C C******************************************************************************* END_OF_LINK = .FALSE. LIB_CODE = .FALSE. NEW_OBJ_CODE = .FALSE. LAST_LINE = .FALSE. LINK_PNTR = 1 C******************************************************************************* C C If the LINK command explicity declares the name of the executable C image being built using the DCL "/EXE" command parameter , extract C the parameter list after the "/EXE" from the DCL command line, C convert it to lower case, and extract the filename corresponding to C the "/EXE" parameter. C C******************************************************************************* IF (INDEX(DCL_RECORD,EXE_PAR) .NE. 0) * THEN EXECFILE = DCL_RECORD(INDEX(DCL_RECORD,EXE_PAR)+5: * INDEX(DCL_RECORD,SPACE)-1) CALL VTU_CHCASE(EXECFILE,EXECFILE,LOWERCASE) IF (INDEX(EXECFILE,SLASH) .NE. 0) * THEN EXECFILE = EXECFILE(1:INDEX(EXECFILE,SLASH)-1) ENDIF ENDIF C******************************************************************************* C C Initialize the rest of the line to everything after the DCL command C and it's parameters. Process the LINK command, continuing until C the end of link command flag is set. If a hyphen character is not C found in the line, it is the last line in the LINK command since the C hyphen is the DCL continuation character, so set the last line found C flag to TRUE. C C******************************************************************************* REST_OF_LINE = * DCL_RECORD(INDEX(DCL_RECORD,SPACE)+1:LEN(DCL_RECORD)) C DO WHILE (.NOT.(END_OF_LINK)) IF (INDEX(REST_OF_LINE,HYPHEN) .EQ. 0) * THEN LAST_LINE = .TRUE. ENDIF C******************************************************************************* C C Initialize end of line flag to FALSE and until the end of line C flag is set to TRUE, get the next VMS file specification if one C exists, if not set the end of line flag. If a VMS file specification C exists, then continue. C C******************************************************************************* END_OF_LINE = .FALSE. DO WHILE (.NOT. (END_OF_LINE)) CALL VTU_GETFILE(REST_OF_LINE,FILESPEC) write(6,*)' getfile ',filespec IF (FILESPEC(1:1) .EQ. NULL_STRING .OR. * FILESPEC(1:1) .EQ. SPACE .OR. * FILESPEC(1:1) .EQ. HYPHEN) * THEN END_OF_LINE = .TRUE. ELSE C******************************************************************************* C C At this point we have a valid VMS file specification in the LINK C command. Determine its size and location and set the rest of the C line to be everything after the valid VMS file specification. If C the file specification contains a DCL variable delimited by single C quotes, extract the variable and insert it's equivalent value. C C******************************************************************************* FSLOC = INDEX(REST_OF_LINE, * FILESPEC(1:INDEX(FILESPEC,SPACE))) FSLEN = LEN(FILESPEC(1:INDEX(FILESPEC,SPACE)))+1 REST_OF_LINE = * REST_OF_LINE(FSLOC+FSLEN:LEN(REST_OF_LINE)) IF (INDEX(FILESPEC,QUOTE) .NE. 0) * THEN CALL VTU_VAR_EXP(FILESPEC,VAR_VALUE,UNIX_STR) CALL VTU_VAR_INS(FILESPEC,VAR_VALUE,VMSFILE) ENDIF C******************************************************************************* C C If the VMS file specification is not for a library file, then C invoke the VMS file specification breakdown utility to break the C file specification into a directory specification and a filename. C Set the new object code found flag to TRUE, and invoke the C change case utility to make a lowercase Unix copy of the filename. C Add the Unix copy of the filename to the list of files to link in C on the FX/1. C C******************************************************************************* IF (INDEX(FILESPEC,LIB_PAR) .EQ. 0) * THEN CALL VTU_VMSFSB(FILESPEC,NOT_USED,DIRSPEC, * VMSFILE,NOT_USED,NOT_USED) NEW_OBJ_CODE = .TRUE. CALL VTU_CHCASE(VMSFILE,UNIXFILE,LOWERCASE) LINK_LIST(LINK_PNTR) = * UNIXFILE(1:INDEX(UNIXFILE,SPACE)-1)//DOT//O LINK_PNTR = LINK_PNTR + 1 C******************************************************************************* C C Create FTP utility command to SEND the FX/FORTRAN source code C file to the FX/1 and output the command to the file containing C the FTP SEND commands. C C******************************************************************************* WRITE_BUFFER = * VMSFILE(1:INDEX(VMSFILE,SPACE)-1)//DOT_BF// * JOBNUM//SPACE//UNIXFILE(1:INDEX(UNIXFILE,SPACE)-1) * //DOT_LF WRITE(FTPSENDUNIT,100)WRITE_BUFFER C******************************************************************************* C C Create command to compile the FX/FORTRAN source code file on C the FX/1 and output the command to the C Shell Script file C being constructed. C C******************************************************************************* WRITE_BUFFER = * UNIXFILE(1:INDEX(UNIXFILE,SPACE)-1)//DOT_LF WRITE(CSCRIPTUNIT,200)WRITE_BUFFER C******************************************************************************* C C Recreate the VMS file specification from the VMS directory C specification and the VMS filename. Invoke the routine to C convert a copy of the VAX FORTRAN source code file to FX/FORTRAN. C If an executable file has yet to be specified, set the executable C filename as Unix equivalent of the VMS filename. Note: If the C "/EXE" is not specified on a DCL LINK command, the executable file C name will that of the first file in the LINK command. C C******************************************************************************* FILESPEC = DIRSPEC(1:INDEX(DIRSPEC,SPACE)-1)// * VMSFILE CALL VTU_CONSC(FILESPEC,VMSFILE,JOBNUM) IF (EXECFILE(1:1) .EQ. NULL_STRING) * THEN EXECFILE = UNIXFILE ENDIF ELSE C******************************************************************************* C C At this point the file specification in the DCL LINK command C is for a library file specification. Set the library code found C flag to TRUE. Invoke the VMS file specification breakdown utility C to break the file specification down into a VMS directory C specification and a VMS filename. Check the library file C specification for explicitly INCLUDED files which are denoted by C the DCL "/INC" argument qualifier. C C******************************************************************************* LIB_CODE = .TRUE. CALL VTU_VMSFSB(FILESPEC,NOT_USED,DIRSPEC, * VMSFILE,NOT_USED,NOT_USED) IF (INDEX(VMSFILE,INC_PAR) .NE. 0) * THEN C******************************************************************************* C C Since the library file specification contained explicitly C INCLUDED files, extract the INCLUDED file list from the C argument qualifier removing slashes and parentheses where C necessary. Convert the list to lowercase. Walk through the C list taking each INCLUDED filename and add it to the list C of arguments to the FX/1 linker command. C C******************************************************************************* INC_LOC = INDEX(VMSFILE,INC_PAR) INCLIST = VMSFILE(INC_LOC+1: * INDEX(VMSFILE,SPACE)-1) INCLIST = INCLIST(INDEX(INCLIST,EQ_SIGN)+1: * LEN(INCLIST)) IF (INDEX(INCLIST,SLASH) .NE. 0) * THEN INCLIST = INCLIST(1:INDEX(INCLIST,SLASH)-1) ENDIF IF (INCLIST(1:1) .EQ. LEFT_PAREN) * THEN INCLIST = * INCLIST(2:INDEX(INCLIST,RIGHT_PAREN)-1) ENDIF CALL VTU_CHCASE(INCLIST,INCLIST,LOWERCASE) DO WHILE (INCLIST(1:1) .NE. SPACE) CALL VTU_GETFILE(INCLIST,INCFILE) IF (INDEX(INCLIST,COMMA) .EQ. 0) * THEN INCLIST = SPACE ELSE NEXT_FILE = INDEX(INCLIST,COMMA) + 1 INCLIST = INCLIST(NEXT_FILE:LEN(INCLIST)) ENDIF LINK_LIST(LINK_PNTR) = OBJECT// * INCFILE(1:INDEX(INCFILE,SPACE)-1)//DOT//O LINK_PNTR = LINK_PNTR + 1 ENDDO ENDIF C******************************************************************************* C C Extract the VMS library file name from the command argument, C convert it to lower case, append the ".olb" file type to it, C and add it to the list of arguments for the FX/1 linker command. C C******************************************************************************* LIBFILE = * VMSFILE(1:INDEX(VMSFILE,LIB_PAR)-1) CALL VTU_CHCASE(LIBFILE,LIBFILE,LOWERCASE) LIBFILE = * LIBFILE(1:INDEX(LIBFILE,SPACE)-1)//OLB LINK_LIST(LINK_PNTR) = LIBFILE LINK_PNTR = LINK_PNTR + 1 C******************************************************************************* C C Construct the command to copy the library file from the C "vaxlib" directory on the FX/1 holding the library files to C the directory the job is running in and the "ranlib" command C to randomize the library. Output these commands to the C Shell C Script file being constructed. C C******************************************************************************* WRITE_BUFFER = * LIBFILE(1:INDEX(LIBFILE,SPACE))// * LIBFILE(1:INDEX(LIBFILE,SPACE)) WRITE(CSCRIPTUNIT,300)WRITE_BUFFER WRITE_BUFFER = * LIBFILE(1:INDEX(LIBFILE,SPACE)) WRITE(CSCRIPTUNIT,400)WRITE_BUFFER ENDIF ENDIF ENDDO C******************************************************************************* C C If the DCL line just processed was the last line of the LINK C command, then set the end of link command found flag to TRUE. C Otherwise, read the next DCL line form the input command file, C output a commented out copy of it to the C Shell Script file C being constructed, invoke the DCL line compress utility to C compress out mutliple spaces in the line and determine if the C line is the last line of the LINK command. C C******************************************************************************* IF (LAST_LINE) * THEN END_OF_LINK = .TRUE. ELSE READ(VAXDCLUNIT,500)REST_OF_LINE WRITE(CSCRIPTUNIT,600)REST_OF_LINE CALL VTU_COMPRESS(REST_OF_LINE) IF (INDEX(REST_OF_LINE,HYPHEN) .EQ. 0) * THEN LAST_LINE = .TRUE. ENDIF ENDIF ENDDO C******************************************************************************* C C Construct the FX/1 linker command denoted by the "fortran -t -o" C command with the correct executable filename and output the C command to the C Shell Script file. Follow the command with the C FX/1 C Shell continuation character, the back slash. C C******************************************************************************* WRITE_BUFFER = EXECFILE(1:INDEX(EXECFILE,SPACE)-1)// * USCORE//JOBNUM//SPACE//B_SLASH WRITE(CSCRIPTUNIT,700)WRITE_BUFFER C******************************************************************************* C C Initialize list pointers and walk through the list of C arguments to add to the FX/1 link command and output each C followed by the back slash continuation character to the C C Shell Script file. After each has been written, output C the rest of the command to link in the built in VAX C FORTRAN library functions, denoted by "-lvax" that Alliant C supplies with the FX/1. C C******************************************************************************* LAST_ONE = LINK_PNTR - 1 LINK_PNTR = 1 DO WHILE (LINK_PNTR .LE. LAST_ONE) WRITE(CSCRIPTUNIT,800)LINK_LIST(LINK_PNTR),B_SLASH LINK_PNTR = LINK_PNTR + 1 ENDDO WRITE(CSCRIPTUNIT,900) RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT(' send ',A74) 200 FORMAT('fortran -c ',A68) 300 FORMAT('cp ../vaxlibs/',A65) 400 FORMAT('ranlib ',A39) 500 FORMAT(A80) 600 FORMAT('#',A78) 700 FORMAT('fortran -t -o ',A55) 800 FORMAT(2X,A47,A1) 900 FORMAT(' -lvax ') END SUBROUTINE VTU_PARSE(DCL_RECORD,JOBNUM) C******************************************************************************* C C TITLE: VTU command line PARSEr C AUTHOR: Glen D. West C DATE: August, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This routine invokes the appropriate VTU processing C routine for DCL variable assignment statements and C commands line containing one of the following commands C or command abbreviations, (ASSIGN, APPEND, COPY, CREATE, C DELETE, LINK, RUN, and TYPE). Abbreviations must be C at least three characters in length. DCL comment and C label statements as well as invalid DCL command statements C are ignored. C C INPUTS: C C DCL_RECORD - Read in DCL command card C JOBNUM - Number of the job C C OUTPUTS: C C None C C CALLED BY: C C VTU_MAIN - VTU main processing routine C C CALLS TO: C C VTU_COMPRESS - Compresses multiple spaces in a string into C a single space C VTU_IN_STRING - Logical function that returns TRUE if a C substring is in a string, FALSE otherwise C VTU_VAR_ASS - VTU VARiable ASSignment processing routine C VTU_APPEND - VTU APPEND statement conversion C VTU_ASSIGN - VTU ASSIGN statement conversion C VTU_COPY - VTU COPY statement conversion C VTU_CREATE - VTU CREATE statement conversion C VTU_DELETE - VTU DELETE statement conversion C VTU_LINK - VTU LINK statement conversion C VTU_RUN - VTU RUN statement conversion C VTU_TYPE - VTU TYPE statement conversion C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 COLON, ! Colon character * DOLLAR_SIGN, ! Dollar sign character * EXC_PT, ! Exclamation point character * JOBNUM, ! Number of the job * SPACE ! Single space character C CHARACTER*2 COL_EQ ! Colon, equal sign 2 character C ! sequence C CHARACTER*32 DCL_COMMAND ! DCL command extracted from the C ! DCL command card CHARACTER*80 DCL_RECORD ! Input DCL command card C INTEGER CRNUM, ! CREATE statement number, used for C ! tagging EOF markers in create C ! commands * EOC, ! End of Command pointer * UPPERCASE ! Convert to uppercase indicator C LOGICAL COMMENT, ! TRUE if the DCL command line is a C ! comment, FALSE otherwise * LABEL, ! TRUE if the DCL command line is a C ! label, FALSE otherwise * VAR_ASSIGN, ! TRUE if command is a VMS DCL variable C ! assignment statement, FALSE otherwise * VTU_IN_STRING ! TRUE if a substring is in the C ! string, FALSE otherise EXTERNAL VTU_IN_STRING ! Logical function to determine if a C ! substring is in a string C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA COLON /':'/, * COL_EQ /':='/, * CRNUM /0/, * DOLLAR_SIGN /'$'/, * EXC_PT /'!'/, * SPACE /' '/, * UPPERCASE /-1/ C C******************************************************************************* C C C******************************************************************************* C C Since valid DCL commands must begin with a dollar sign character, C do nothing if no such character exists. If the line has the dollar C sign character, compress out the multiple spaces in the command C line, extract the DCL command from the line and determine if the C line is a comment or label. C C******************************************************************************* IF (INDEX(DCL_RECORD,DOLLAR_SIGN) .NE. 0) * THEN 100 CONTINUE CALL VTU_COMPRESS(DCL_RECORD) DCL_COMMAND = DCL_RECORD(2:INDEX(DCL_RECORD,SPACE)) COMMENT = VTU_IN_STRING(DCL_COMMAND(1:1),EXC_PT) EOC = INDEX(DCL_COMMAND,SPACE) - 1 LABEL = VTU_IN_STRING(DCL_COMMAND(EOC:EOC),COLON) C******************************************************************************* C C If the command line is a comment or label, simply ignore it. C C******************************************************************************* IF (COMMENT .OR. LABEL) * THEN RETURN ELSE C******************************************************************************* C C At this point, we have a valid DCL command. Determine if the C command is assigning a value to a VMS DCL variable. If so invoke C the routine to process the variable assignment. C C******************************************************************************* VAR_ASSIGN = VTU_IN_STRING(DCL_RECORD,COL_EQ) IF (VAR_ASSIGN) * THEN CALL VTU_VAR_ASS(DCL_RECORD) ELSE C******************************************************************************* C C Extract the command from the command line and convert the command C to uppercase in case the user has used lowercase instead. For each C of the DCL commands that VTU supports, (ASSIGN, APPEND, COPY, C CREATE, DELETE, LINK, RUN and TYPE), invoke the appropriate VTU C processing routine to process the command. If the command is a CREATE C command, make sure to loop back and parse again as the CREATE command C handler reads in-line data until it gets the next DCL_RECORD C beginning with "$" to indicate a valid DCL command. C C******************************************************************************* DCL_COMMAND = DCL_COMMAND(1:3) CALL VTU_CHCASE(DCL_COMMAND,DCL_COMMAND, * UPPERCASE) IF (DCL_COMMAND .EQ. 'ASS') * THEN CALL VTU_ASSIGN(DCL_RECORD) ELSE IF (DCL_COMMAND .EQ. 'APP') * THEN CALL VTU_APPEND(DCL_RECORD) ELSE IF (DCL_COMMAND .EQ. 'COP') * THEN CALL VTU_COPY(DCL_RECORD) ELSE IF (DCL_COMMAND .EQ. 'CRE') * THEN CALL VTU_CREATE(DCL_RECORD,CRNUM) GOTO 100 ELSE IF (DCL_COMMAND .EQ. 'DEL') * THEN CALL VTU_DELETE(DCL_RECORD) ELSE IF (DCL_COMMAND .EQ. 'LIN') * THEN CALL VTU_LINK(DCL_RECORD,JOBNUM) ELSE IF (DCL_COMMAND .EQ. 'RUN') * THEN CALL VTU_RUN(DCL_RECORD,JOBNUM) ELSE IF (DCL_COMMAND(1:2) .EQ. 'TY') * THEN CALL VTU_TYPE(DCL_RECORD) C ENDIF ENDIF ENDIF ENDIF RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C None C C******************************************************************************* C END SUBROUTINE VTU_RUN(DCL_RECORD,JOBNUM) C******************************************************************************* C C TITLE: VTU RUN statement conversion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This routine converts the VMS DCL "RUN" command to the C equivalent "execute" command of 4.2 BSD Unix and C outputs the built Unix command to the C Shell command C script being constructed. The file specification is C converted from a VMS to a Unix specification, including C the conversion to lower case and any necessary variable C substition in the filename. C C INPUTS: C C DCL_RECORD - Input DCL card containing "RUN" command C C OUTPUTS: C C None C C CALLED BY: C C VTU_PARSE - VTU Command Line Parser C C CALLS TO: C C VTU_GETFILE - Returns next VMS file specification from C specified character string C VTU_VAR_EXP - Returns variable value and equivalent Unix C variable string for DCL variables character C strings C VTU_VAR_INS - Replaces a variable in a character string C with specified character string C VTU_FSCON - Converts file specifications from VMS to C Unix C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 JOBNUM, ! Number of the job * QUOTE, ! Single quote character * SPACE, ! Single space character * USCORE ! Underscore character CHARACTER*13 UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " C CHARACTER*15 REM_COMMAND ! Remainder of the command CHARACTER*32 VAR_VALUE ! DCL Variable value CHARACTER*64 UNIXFILE, ! Unix equivalent of VMS file C ! specification * VMSFILE ! VMS file specification CHARACTER*80 DCL_RECORD, ! Input DCL command card * WRITE_BUFFER ! Output buffer INTEGER EO_UNIXFILE, ! * LOWERCASE ! Convert to lowercase indicator C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA LOWERCASE /1/, * QUOTE /39/, ! ASCII(single quote) = decimal 39 C * REM_COMMAND /' | fpr ; time )'/, * SPACE /' '/, * USCORE /'_'/ C C******************************************************************************* C C C******************************************************************************* C C Shift off the DCL RUN command, get the executable filename, C expand any DCL variables it may contain, convert it to the C equivalent Unix file specification and convert the Unix C specification to lowercase. C C******************************************************************************* DCL_RECORD = * DCL_RECORD(INDEX(DCL_RECORD,SPACE)+1:LEN(DCL_RECORD)) CALL VTU_GETFILE(DCL_RECORD,VMSFILE) IF (INDEX(VMSFILE,QUOTE) .NE. 0) * THEN CALL VTU_VAR_EXP(VMSFILE,VAR_VALUE,UNIX_STR) CALL VTU_VAR_INS(VMSFILE,UNIX_STR,VMSFILE) ENDIF CALL VTU_FSCON(VMSFILE,UNIXFILE) CALL VTU_CHCASE(UNIXFILE,UNIXFILE,LOWERCASE) C******************************************************************************* C C Construct the execute command and output it to the C Shell C Script file in the form: C C ( execute unixfile_i | fpr ; time ) C C where: i is the number of the job, C fpr converts FORTRAN carriage control formats C time times the job C C******************************************************************************* WRITE_BUFFER = UNIXFILE(1:INDEX(UNIXFILE,SPACE)-1)// * USCORE//JOBNUM//REM_COMMAND WRITE(CSCRIPTUNIT,100)WRITE_BUFFER RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT('( execute ',A70) END SUBROUTINE VTU_TYPE(DCL_RECORD) C******************************************************************************* C C TITLE: VTU TYPE statement conversion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This routine converts the VMS DCL "TYPE" command C to the equivalent "cat" command of 4.2 BSD Unix and C outputs the built Unix command to the C Shell command C script being constructed. The file specification is C converted from a VMS to a Unix specification, including C the conversion to lower case and any necessary variable C substition in the filename. This routine also handles C "TYPE" statements that output the contents of a given C Fortran IO channel such as $TYPE FOR037. C C INPUTS: C C DCL_RECORD - Input DCL card containing DCL "TYPE" command C C OUTPUTS: C C None C C CALLED BY: C C VTU_PARSE - VTU Command Line Parser C C CALLS TO: C C VTU_GETFILE - Returns next VMS file specification from C specified character string C VTU_VAR_EXP - Returns variable value and equivalent Unix C variable string for DCL variables character C strings C VTU_VAR_INS - Replaces a variable in a character string C with specified character string C VTU_FSCON - Converts file specifications from VMS to C Unix C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 BAR, ! Vertical bar character * DOT, ! Period or dot character * QUOTE, ! Single quote character * SPACE ! Single space character CHARACTER*3 FORSPEC, ! "FOR" in FOR'xxx' Fortran IO C ! specification * FPR ! "fpr" character string CHARACTER*13 UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " CHARACTER*32 VAR_VALUE ! DCL variable value CHARACTER*64 UNIXFILE, ! Unix equivalent of VMS file C ! specification * VMSFILE ! VMS file specification CHARACTER*80 DCL_RECORD ! Input DCL command card INTEGER LOWERCASE ! Convert to lowercase indicator C******************************************************************************* C C DATA: ! Initialize necessary data C DATA BAR /'|'/, * DOT /'.'/, * FORSPEC /'FOR'/, * FPR /'fpr'/, * LOWERCASE /1/, * QUOTE /39/, ! ASCII(single quote) = decimal 39 * SPACE /' '/ C C******************************************************************************* C C C******************************************************************************* C C Shift the TYPE command off of the command line, get the VMS C file specification of the file to be typed, and expand any DCL C variables it may contain. C C******************************************************************************* DCL_RECORD = * DCL_RECORD(INDEX(DCL_RECORD,SPACE)+1:LEN(DCL_RECORD)) CALL VTU_GETFILE(DCL_RECORD,VMSFILE) IF (INDEX(VMSFILE,QUOTE) .NE. 0) * THEN CALL VTU_VAR_EXP(VMSFILE,VAR_VALUE,UNIX_STR) CALL VTU_VAR_INS(VMSFILE,UNIX_STR,VMSFILE) ENDIF C******************************************************************************* C C If the VMS file specification is a Fortran IO specification C "FOR'xxx'" where 'xxx' = 0,...99, then output the corresponding C "cat" command to the C Shell Script file being constructing. C C******************************************************************************* IF (VMSFILE(1:3) .EQ. FORSPEC .AND. * INDEX(VMSFILE,DOT) .EQ. 0) * THEN WRITE(CSCRIPTUNIT,100)VMSFILE ELSE C******************************************************************************* C C Otherwise, convert the VMS file specification to the equivalent C Unix file specification and convert the Unix file specification C to lowercase. Append the necessary characters to filter the "cat" C command output through the "fpr" utility to convert Fortran C carriage control characters appropriately. Output the Unix "cat" C command to the C Shell Script file being constructed. C C******************************************************************************* CALL VTU_FSCON(VMSFILE,UNIXFILE) CALL VTU_CHCASE(UNIXFILE,UNIXFILE, * LOWERCASE) UNIXFILE = * UNIXFILE(1:INDEX(UNIXFILE,SPACE))//BAR//SPACE//FPR WRITE(CSCRIPTUNIT,200)UNIXFILE ENDIF RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 100 FORMAT('cat $',A32) 200 FORMAT('cat ',A32) END SUBROUTINE VTU_VAR_ASS(DCL_RECORD) C******************************************************************************* C C TITLE: VTU VARiable ASSignment statement conversion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This routine puts the VMS DCL variable name, it's Unix C translation and it's value in global arrays for C use in expanding the variables when they are found C in DCL command lines. It also outputs the "set" C command to the C Shell Script file being constructed C to assign the same variable during the script file C execution on the FX/1. The "set" command is output C for every DCL variable assignment statement found C except if the variable name is "W" or "WPID" because C these are special variables used by the BEWSS C simulation and the "set" commands for them have already C been output by the VTU_INIT routine. VTU restricts DCL C variable names to 10 characters and their assigned C values to 32 characters. VTU does allow the redifinition C of DCL variables within a command file. C C INPUTS: C C DCL_RECORD - Input DCL command card containing the DCL C variable assignment statement C C OUTPUTS: C C None C C CALLED BY: C C Numerous routines C C CALLS TO: C C VTU_CHCASE - Changes case of specified string from upper C to lower case or vice versa. C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C Fortran IO channels C COMMON /VTU_GLOBALS/ VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT INTEGER VAXDCLUNIT, * CSCRIPTUNIT, * FTPSENDUNIT, * FTPGETUNIT C C******************************************************************************* C C VMS DCL symbolic variable name, unix evaluation string and C value arrays C COMMON /VAR_ARRAYS/ VAR_NAM_LIST,UNIX_VARS,VAR_VAL_LIST C CHARACTER*10 VAR_NAM_LIST(50) CHARACTER*13 UNIX_VARS(50) CHARACTER*32 VAR_VAL_LIST(50) C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 DB_QUOTE, ! Double quote character * DOLLAR_SIGN, ! Dollar sign character * EQ_SIGN, ! Equals sign character * LEFT_BRACK, ! Left pointed bracket character * QUOTE, ! Single quote character * RIGHT_BRACK, ! Right pointed bracket character * NULL_STRING, ! Empty string character * SPACE, ! Single space character * W ! Captial W character C CHARACTER*2 COL_EQ ! Colon-equals sign character sequence C CHARACTER*4 WPID ! "WPID" character sequence C CHARACTER*10 VAR_NAME ! DCL variable name CHARACTER*32 VAR_VALUE ! DCL variable value C CHARACTER*80 DCL_RECORD, ! Input DCL command card * WRITE_BUFFER ! Output buffer C INTEGER A_INDX, * COL_EQ_LOC, ! Location of colon - equals sign C ! character sequence * LOWERCASE ! Convert to lowercase indicator C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA COL_EQ /':='/, * DB_QUOTE /'"'/, * DOLLAR_SIGN /'$'/, * EQ_SIGN /'='/, * LEFT_BRACK /'{'/, * LOWERCASE /1/, * QUOTE /39/, ! ASCII(single quote) = decimal 39 * RIGHT_BRACK /'}'/, * NULL_STRING /0/, ! ASCII(null string) = decimal 0 * SPACE /' '/, * W /'W'/, * WPID /'WPID'/ C C******************************************************************************* C C C******************************************************************************* C C Extract the DCL variable name and the variable it is being C assigned to from the DCL command. The DCL variable assignment C statements are of the form: C C variable name :[=]= ["]variable value["] C C where one of the equals signs and the double quotes surrounding C the value are optional. C C******************************************************************************* COL_EQ_LOC = INDEX(DCL_RECORD,COL_EQ) VAR_NAME = DCL_RECORD(2:COL_EQ_LOC-1) VAR_VALUE = DCL_RECORD(COL_EQ_LOC+2:LEN(DCL_RECORD)) IF (VAR_VALUE(1:1) .EQ. EQ_SIGN) * THEN VAR_VALUE = VAR_VALUE(2:LEN(VAR_VALUE)) ENDIF IF (INDEX(VAR_VALUE,DB_QUOTE) .NE. 0) * THEN VAR_VALUE = * VAR_VALUE(INDEX(VAR_VALUE,DB_QUOTE)+1:LEN(VAR_VALUE)) IF (INDEX(VAR_VALUE,DB_QUOTE) .NE. 0) * THEN VAR_VALUE = * VAR_VALUE(1:INDEX(VAR_VALUE,DB_QUOTE)-1) ENDIF ENDIF C******************************************************************************* C C Walk through the global list of variable names. If the name of C the current DCL variable is found, replace it's value in the C global list of variable values with the new value. C C******************************************************************************* A_INDX = 1 DO WHILE (A_INDX .LT. 50 .AND. * VAR_NAM_LIST(A_INDX)(1:1) .NE. NULL_STRING) IF (VAR_NAM_LIST(A_INDX) .EQ. VAR_NAME) * THEN VAR_VAL_LIST(A_INDX) = VAR_VALUE GOTO 100 ENDIF A_INDX = A_INDX + 1 ENDDO C******************************************************************************* C C At this point, the current DCL variable name was not found in C the global variable name list, so insert it at the end of that C list. Insert it's value at the corresponding location in the C global variable value list. For a Unix C Shell Script file to C evaluate the variable, it must be in the form: ${ variable name } C This form is therefore stored in the global Unix variables list in C the position corresponding to the location in the previous two C lists. C C******************************************************************************* VAR_NAM_LIST(A_INDX) = VAR_NAME VAR_VAL_LIST(A_INDX) = VAR_VALUE UNIX_VARS(A_INDX) = * DOLLAR_SIGN//LEFT_BRACK// * VAR_NAME(1:INDEX(VAR_NAME,SPACE)-1)//RIGHT_BRACK C******************************************************************************* C C As long as the variable name is not "W" or "WPID" as mentioned C above, the "set" command is constructed in the form: C C set variable name = 'variable value' C C to evaluate the variable in the C Shell Script file being C constructed and is then output to that file. C C******************************************************************************* IF (VAR_NAME(1:INDEX(VAR_NAME,SPACE)-1) .NE. WPID .AND. * VAR_NAME(1:INDEX(VAR_NAME,SPACE)-1) .NE. W) * THEN CALL VTU_CHCASE(VAR_NAME,VAR_NAME,LOWERCASE) WRITE_BUFFER = * VAR_NAME(1:INDEX(VAR_NAME,SPACE))//EQ_SIGN//SPACE// * QUOTE//VAR_VALUE(1:INDEX(VAR_VALUE,SPACE)-1)//QUOTE WRITE(CSCRIPTUNIT,200)WRITE_BUFFER ENDIF 100 CONTINUE RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C******************************************************************************* C 200 FORMAT('set ',A45) END SUBROUTINE VTU_VAR_EXP(INSTRING,VAR_VALUE,UNIX_STR) C******************************************************************************* C C TITLE: VTU VARiable EXPansion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This routine returns the VMS DCL variable value and the C Unix string to evaluate the variable in a C Shell C Script for the DCL variable in the given input C character string. These two entities have been stored C in global lists by the VTU variable assignment C statement processor. C C INPUTS: C C INSTRING - Input string containing DCL variable C C OUTPUTS: C C VAR_VALUE - Value of DCL variable C UNIX_STR - Unix string to evaluate the variable in C a C Shell Script C C CALLED BY: C C Numerous routines C C CALLS TO: C C None C C******************************************************************************* C C GLOBALS: C C******************************************************************************* C C******************************************************************************* C C VMS DCL symbolic variable name, unix evaluation string and C value arrays C COMMON /VAR_ARRAYS/ VAR_NAM_LIST,UNIX_VARS,VAR_VAL_LIST C CHARACTER*10 VAR_NAM_LIST(50) CHARACTER*13 UNIX_VARS(50) CHARACTER*32 VAR_VAL_LIST(50) C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 NULL_STRING, ! Empty string character * QUOTE, ! Single quote character * SPACE ! Single space character C CHARACTER*10 VAR_NAME ! DCL variable name CHARACTER*13 UNIX_STR ! Unix string containing variable and C ! symbols to evaluate it " ${...} " C CHARACTER*32 INSTRING, ! Input string containing the DCL C ! variable * VAR_VALUE ! Value of DCL variable C INTEGER A_INDX, ! Global array index * QUOTE1, ! Location of first single quote in C ! the input string * QUOTE2 ! Location of second single quote in C ! the input string C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA NULL_STRING /0/, ! ASCII(null string) = decimal 0 * QUOTE /39/, ! ASCII(single quote) = decimal 39 * SPACE /' '/ C C******************************************************************************* C C C******************************************************************************* C C Locate and extract the DCL variable from the input character C string. To evaluate a variable in DCL it must fall between C single quotes. C C******************************************************************************* QUOTE1 = INDEX(INSTRING,QUOTE) QUOTE2 = QUOTE1 + * INDEX(INSTRING(QUOTE1+1:LEN(INSTRING)),QUOTE) VAR_NAME = INSTRING(QUOTE1+1:QUOTE2-1) C******************************************************************************* C C Walk through the global DCL variable list until the current C variable is found. Assign the return variable value and C Unix evaluation string to the corresponding entries found C in the global lists for them. C C******************************************************************************* A_INDX = 1 DO WHILE (A_INDX .LT. 50 .AND. * VAR_NAM_LIST(A_INDX)(1:1) .NE. NULL_STRING) IF (VAR_NAME .EQ. VAR_NAM_LIST(A_INDX)) * THEN VAR_VALUE = VAR_VAL_LIST(A_INDX) UNIX_STR = UNIX_VARS(A_INDX) GOTO 100 ENDIF A_INDX = A_INDX + 1 ENDDO 100 CONTINUE RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C None C C******************************************************************************* C END SUBROUTINE VTU_VAR_INS(INSTRING,VAR_SSTR,OUTSTRING) C******************************************************************************* C C TITLE: VTU VARiable INSertion C AUTHOR: Glen D. West C DATE: September, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This utility replaces the VMS DCL variable in the C given input string with the given input variable C substring and returns the new string in an output C string. C C INPUTS: C C INSTRING - String containing the DCL variable C VAR_SSTR - Variable Substring to be substituted into C the DCL variable C C OUTPUTS: C C OUTSTRING - String containing the inserted substring C C CALLED BY: C C Numerous routines C C CALLS TO: C C None C C******************************************************************************* C C GLOBALS: C C None C C******************************************************************************* C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*1 QUOTE, ! Single quote character * SPACE ! Single space character C CHARACTER*(*) INSTRING, ! Input string * OUTSTRING, ! Output string * VAR_SSTR ! Input variable substring C C INTEGER END_LOC, ! Ending location of the DCL variable C ! in the input string * VAR_LEN, ! Length of the input substring * VAR_LOC ! Location of the DCL variable in the C ! input string C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA QUOTE /39/, ! ASCII(single quote) = decimal 39 * SPACE /' '/ C C******************************************************************************* C C C******************************************************************************* C C Locate the DCL variable in the input string. The DCL variable lies C between the single quotes. Record length of the input substring to C be inserted. C C******************************************************************************* VAR_LOC = INDEX(INSTRING,QUOTE) END_LOC = VAR_LOC + * INDEX(INSTRING(VAR_LOC+1:LEN(INSTRING)),QUOTE) VAR_LEN = INDEX(VAR_SSTR,SPACE) C******************************************************************************* C C Construct the return string argument replacing the DCL variable C and it's enclosing single quotes with the input substring. C C******************************************************************************* OUTSTRING = INSTRING(1:VAR_LOC-1)// * VAR_SSTR(1:VAR_LEN-1)// * INSTRING(END_LOC+1:LEN(INSTRING)) RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C None C C******************************************************************************* C END SUBROUTINE VTU_VMSFSB(FILESPEC,DEVICE,DIRSPEC,FILENAME, * FILETYPE,VERSION) C******************************************************************************* C C TITLE: VTU VMS File Specification Breakdown C AUTHOR: Glen D. West C DATE: October, 1986 C LANG: VAX FORTRAN C C PURPOSE: C C This utility excepts a VMS file specification as input C and breaks it down into it's components returning each C as an output argument. DECNET node specifications are C assumed not in the file specifications since we do not C have DECNET. The VMS file specification then given by: C C device : [ directory ] filename . filetype ; version C C The only required element of the file specification is C the filename. Any of the others that are not given in C the file specification are returned in their corresponding C return arguments as spaces. C C INPUTS: C C FILESPEC - VMS file specification C C OUTPUTS: C C DEVICE - The device specification C DIRSPEC - The directory specification C FILENAMe - The filename C FILETYPE - The file type C VERSION - The version number C C CALLED BY: C C Numerous routines C C CALLS TO: C C None C C******************************************************************************* C C GLOBALS: C C None C C******************************************************************************* C C******************************************************************************* C C LOCALS: C C******************************************************************************* C CHARACTER*(*) DEVICE, ! Output device specification * DIRSPEC, ! Output directory specification * FILENAME, ! Output filename * FILESPEC, ! Input VMS file specification * FILETYPE, ! Output file type * VERSION ! Output version number C CHARACTER*1 COLON, ! Colon character * DOT, ! Period or dot character * LBRACK, ! Left square bracket character * RBRACK, ! Right square bracket character * SPACE, ! Single space character * SEMICOLON ! Semicolon character C INTEGER LBRACK_LOC, ! Left bracket location * PNTR ! Pointer into input VMS file C ! specification character string C LOGICAL BRACK_FLAG ! TRUE when left bracket has been C ! found but right bracket has not yet C ! been found, FALSE otherwise C C******************************************************************************* C C DATA: ! Initialize necessary data C DATA COLON /':'/, * DOT /'.'/, * LBRACK /'['/, * RBRACK /']'/, * SPACE /' '/, * SEMICOLON /';'/ C C******************************************************************************* C C C******************************************************************************* C C Initialize the string pointer and bracket flag. Initialize all C return argument strings as spaces except the filename which is C set equal to the whole file specification. C C******************************************************************************* PNTR = 1 BRACK_FLAG = .FALSE. DEVICE = SPACE DIRSPEC = SPACE FILENAME = FILESPEC FILETYPE = SPACE VERSION = SPACE C******************************************************************************* C C Walk through the input file specification a character at a time C C******************************************************************************* DO WHILE (PNTR .LE. LEN(FILESPEC) .AND. * FILESPEC(PNTR:PNTR) .NE. SPACE) C******************************************************************************* C C Finding a colon indicates a device has been specified, so set C the device argument to everything preceding the colon and C shift the device off of the filename. C C******************************************************************************* IF (FILESPEC(PNTR:PNTR) .EQ. COLON) * THEN DEVICE = FILESPEC(1:PNTR-1) FILENAME = FILESPEC(PNTR+1:LEN(FILESPEC)) ELSE C******************************************************************************* C C Finding a left bracket indicates a directory specification is C in the file specification so record the left bracket location C and set the bracket flag. Finding a right bracket indicates the C end of the directory specification so assign the return directory C specification argument to the brackets and the characters between C them, shift the directory specification off of the filename and C clear the bracket flag. C C******************************************************************************* * IF (FILESPEC(PNTR:PNTR) .EQ. LBRACK) * THEN LBRACK_LOC = PNTR BRACK_FLAG = .TRUE. ELSE * IF (FILESPEC(PNTR:PNTR) .EQ. RBRACK) * THEN DIRSPEC = FILESPEC(LBRACK_LOC:PNTR) FILENAME = FILESPEC(PNTR+1:LEN(FILESPEC)) BRACK_FLAG = .FALSE. ELSE C******************************************************************************* C C Finding a period or dot character while the bracket flag is not C set indicates the end of the filename. If the bracket flag were C set the dot would be a part of a directory specification. Truncate C the filename at the dot but not including it. Set the file type to C everything after the dot. C C******************************************************************************* * IF (FILESPEC(PNTR:PNTR) .EQ. DOT .AND. * .NOT. (BRACK_FLAG)) * THEN FILENAME(INDEX(FILENAME,DOT):LEN(FILENAME)) = SPACE FILETYPE = FILESPEC(PNTR+1:LEN(FILESPEC)) ELSE C******************************************************************************* C C Finding a semicolon indicates the end of the file type. Truncate C the file type at the semicolon but not including it. Assign the C version number to the character immediately following the C semicolon. C C******************************************************************************* * IF (FILESPEC(PNTR:PNTR) .EQ. SEMICOLON) * THEN FILETYPE(INDEX(FILETYPE,SEMICOLON):LEN(FILETYPE)) = * SPACE VERSION = FILESPEC(PNTR+1:PNTR+1) ENDIF C******************************************************************************* C C Point to the next character C C******************************************************************************* PNTR = PNTR + 1 ENDDO RETURN C******************************************************************************* C C FORMAT STATEMENTS: C C None C C******************************************************************************* C END