ADAS Subroutine e1file
SUBROUTINE E1FILE( IUNIT , IZ0 , IZ , IRCODE , DSNAME ) C----------------------------------------------------------------------- C C ****************** FORTRAN77 SUBROUTINE: E1FILE ********************* C C PURPOSE: TO OPEN AN IONIZATIONS PER PHOTON DATA SET C C BY DEFAULT AN 'IONELEC' FILE WILL BE USED FOR AN C EMITTING ION WITH NUCLEAR CHARGE 'IZ0' AND CHARGE 'IZ'. C OR, AN ALTERNATIVE DATA SET CAN BE SPECIFICED. C THIS WILL BE CONNECTED TO UNIT 'IUNIT'. C CA DATA FILE OPENED UNDER UNIX : '$ADASCENT/DEFADF/USRGRP/USRTYP/ CA USRGRP_<EXT><ELEMENT><CHARGE>' C C CALLING PROGRAM: SSXB C C SUBROUTINE: C C INPUT : (I*4) IUNIT = UNIT TO WHICH DATA SET WILL BE CONNECTED C INPUT : (I*4) IZ0 = NUCLEAR CHARGE OF EMITTING ION REQUESTED C INPUT : (I*4) IZ = ION CHARGE OF EMITTING ION REQUESTED C C OUTPUT: (I*4) IRCODE = RETURN CODE FROM SUBROUTINE: C 0 => DATA SET SUCCESSFULLY CONNECTED C 1 => REQUESTED DATA SET MEMBER DOES NOT C EXISTS - DATA SET NOT CONNECTED. C 6 => INVALID VALUE FOR 'IZ' ENTERED. C ( 0 <= 'IZ' <= 99 ) C 9 => REQUESTED DATA SET EXISTS BUT CANNOT C BE OPENED. CA OUTPUT: (C*80) DSNAME = FILE NAME INCLUDING PATH C C (I*4) IDLEN = LENGTH, IN BYTES, OF FIXED 'DSNAME' PREFIX C (I*4) LENF1 = FIRST NON-BLANK CHR OF 'DSNAME' GROUP PART C (I*4) LENF2 = LAST NON-BLANK CHR OF 'DSNAME' GROUP PART C (I*4) LENF3 = FIRST NON-BLANK CHR OF 'DSNAME' TYPE PART C (I*4) LENF4 = LAST NON-BLANK CHR OF 'DSNAME' TYPE PART C (I*4) LENF5 = FIRST NON-BLANK CHR OF 'DSNAME' USERID PART C (I*4) LENF6 = LAST NON-BLANK CHR OF 'DSNAME' URESID PART C (I*4) LENF7 = FIRST NON-BLANK CHR OF 'DSNAME' EXTENSION PART C (I*4) LENF8 = LAST NON-BLANK CHR OF 'DSNAME' EXTENSION PART C (I*4) IZEND = LAST BYTE WRITTEN TO IN 'CZ'. (= 1 OR 2) CA (C*1) HASH = '#' if NON-BLANK EXT, ELSE ' '. C (C*2) CZ = 'IZ' (NO LEADING BLANKS) C (C*2) XFESYM = FUNCTION - (SEE ROUTINES SECTION BELOW) C (C*2) ESYM = ELEMENT SYMBOL FOR NUCLEAR CHARGE 'IZ0' C (C*3) USREXT = ADAS SOURCE DATA FILE EXTENSION CA (C*80) USERID = ADAS SOURCE DATA USER ID C (C*8) USRGRP = ADAS SOURCE DATA GROUPNAME CA (C*80) USRTYP = OPTIONAL SUB-DIRECTORY CA (C*6) DEFADF = DEFAULT ADF DATA DIRECTORY, I.E. ADF13 C C (L*4) LEXIST = .TRUE. => REQUESTED DATA SET EXISTS. C .FALSE. => REQUESTED DATA SET DOES NOT C EXIST. C C ROUTINES: C ROUTINE SOURCE BRIEF DESCRIPTION C ------------------------------------------------------------ C XXUID ADAS FETCHES/SETS ADAS SOURCE DATA USER ID C XXSSXB ADAS FETCHES/SETS ADAS SOURCE DATA FILENAME C AND FILE EXTENSION C XFESYM ADAS CHARACTER*2 FUNCTION - C GATHERS ELEMENT SYMBOL FOR NUC. CHARGE C XXSLEN ADAS FINDS FIRST AND LAST NON-BLANK C CHARACTERS IN STRING. C C AUTHOR: PAUL E. BRIDEN (TESSELLA SUPPORT SERVICES PLC) C K1/0/37 C JET EXT. 5023 C C DATE: 01/06/91 C UPDATE: 31/07/91 - PE BRIDEN: ADDED "ACTION='READ'" TO OPEN STATEMENT C UPDATE: 08/08/91 - PE BRIDEN: ADDED "IRCODE=9" => OPEN ERROR C UPDATE: 10/03/93 - PE BRIDEN: ADDED CALL TO XXUID AND USERID VARIABLE C - NOW ALLOWS ANY INPUT DATASET USER ID. C UPDATE: 2/09/93 - HPS : ADDED CALL TO XXSSXB AND USRGRP, USRTYP C AND USREXT NAMES C - NOW ALLOWS ANY INPUT DATASET FILENAME C AND EXTENSION C UPDATE: 23/11/93 - PEB : CORRECT ERROR - A '.' HAD MISTAKENLY C BEEN PLACED BEFORE THE MEMBER NAME IN C VARIABLE DSNAME. C C UPDATE: 26/10/94 - L. JALOTA: MODIFIED CODE FOR RUNNING UNDER UNIX C USING NEW FILENAMING CONVENTION. C "ACTION" KEYWORD IN OPEN COMMAND IS IBM C SO REMOVED HERE. C C UPDATE: 7/11/94 - L. JALOTA: ADDED VARIABLE DEFADF - DEFAULT ADF DIRECTORY C C----------------------------------------------------------------------- C C VERSION: 1.1 DATE: 02-05-95 C MODIFIED: UNKNOWN (SOMEONE FROM TESSELLA SUPPORT SERVICES PLC) C - PUT UNDER SCCS CONTROL C C C VERSION: 1.2 DATE: 19-05-95 C MODIFIED: Hugh Summers C - Introduced hash to eliminate # in file if there is C no extension part of the file name alter logic to C allow usrtyp, usrext to be a single character. C C VERSION: 1.3 DATE: 20-07-07 C MODIFIED: Allan Whiteford C - Modification to comments to allow for automatic C documentation preparation. C C----------------------------------------------------------------------- C C----------------------------------------------------------------------- CHARACTER*80 DSNAME INTEGER IRCODE, IUNIT, IZ, IZ0