ADAS Subroutine e5data
SUBROUTINE E5DATA( IUNIT , DSNAME ,
& NSTORE , NTRDIM , NTDDIM ,
& NBSEL , ISELA ,
& IRZ0 , IRZ1 , IDZ0 ,
& LEQUA ,
& CDONOR , CRECVR , CFSTAT ,
& AMSRA , AMSDA ,
& ITRA , ITDA ,
& TFRA , TFDA ,
& QFTEQA , QFTCXA
& )
C-----------------------------------------------------------------------
C
C ****************** FORTRAN77 SUBROUTINE: E5DATA *********************
C
C PURPOSE: TO FETCH DATA FROM INPUT THERMAL TOTAL CHARGER TRANSFER
C RATE COEFFICIENT FILE FOR GIVN RECEIVER ION ELEMENT.
C (MEMBER STORED IN IONATOM.DATA - MEMBER PREFIX 'TCX#').
C
C CALLING PROGRAM: ADAS505/SQTCX
C
C DATA:
C
C UP TO 'NSTORE' SETS (DATA-BLOCKS) OF DATA MAY BE READ FROM
C THE FILE - EACH BLOCK FORMING A COMPLETE SET OF RATE-
C COEFFICIENTS FOR A GIVEN RECEIVER/DONOR COMBINATION. EACH
C DATA-BLOCK IS ANALYSED INDEPENDENTLY OF ANY OTHER DATA-
C BLOCK.
C
C THE UNITS USED IN THE DATA FILE ARE TAKEN AS FOLLOWS:
C
C TEMPERATURES : EV
C RATE COEFFICIENTS : CM**3 SEC-1
C
C SUBROUTINE:
C
C INPUT : (I*4) IUNIT = UNIT TO WHICH INPUT FILE IS ALLOCATED.
C INPUT : (C*44) DSNAME = MVS DATA SET NAME OF DATA SET BEING READ
C
C INPUT : (I*4) NSTORE = MAXIMUM NUMBER OF INPUT DATA-BLOCKS THAT
C CAN BE STORED.
C INPUT : (I*4) NTRDIM = MAX NUMBER OF RECEIVER TEMPERATURES ALLOWED
C INPUT : (I*4) NTDDIM = MAX NUMBER OF DONOR TEMPERATURES ALLOWED
C
C OUTPUT: (I*4) NBSEL = NUMBER OF DATA-BLOCKS ACCEPTED & READ IN.
C OUTPUT: (I*4) ISELA() = READ - DATA-SET DATA-BLOCK ENTRY INDICES
C DIMENSION: DATA-BLOCK INDEX
C
C OUTPUT: (I*4) IRZ0() = NUCLEAR CHARGE OF RECEIVING IMPURITY ION -
C READ FROM SELECTED DATA-BLOCK.
C DIMENSION: DATA-BLOCK INDEX.
C OUTPUT: (I*4) IRZ1() = INITIAL CHARGE OF RECEIVER -
C READ FROM SELECTED DATA-BLOCK.
C DIMENSION: DATA-BLOCK INDEX.
C OUTPUT: (I*4) IDZ0() = NUCLEAR CHARGE OF NEUTRAL DONOR -
C READ FROM SELECTED DATA-BLOCK.
C DIMENSION: DATA-BLOCK INDEX.
C
C OUTPUT: (L*4) LEQUA() = READ - DATA SET ENTRY FORMAT
C .TRUE. => DATA SET CONTAINS EQUAL
C TEMPERATURE COEFFICIENT.
C .FALSE. => DATA SET DOES NOT CONTAIN
C EQUAL TEMPERATURE COEFFT.
C DIMENSION: DATA-BLOCK INDEX
C OUTPUT: (C*9) CDONOR() = READ - DONOR ION IDENTIFICATION
C DIMENSION: DATA-BLOCK INDEX
C OUTPUT: (C*9) CRECVR() = READ - RECEIVER ION IDENTIFICATION
C DIMENSION: DATA-BLOCK INDEX
C OUTPUT: (C*10) CFSTAT() = READ - FINAL STATE SPECIFICATION
C DIMENSION: DATA-BLOCK INDEX
C OUTPUT: (R*8) AMSRA() = READ - RECEIVER ATOMIC MASS
C DIMENSION: DATA-BLOCK INDEX
C OUTPUT: (R*8) AMSDA() = READ - DONOR ATOMIC MASS
C DIMENSION: DATA-BLOCK INDEX
C
C OUTPUT: (I*4) ITRA() = READ - NUMBER OF RECEIVER TEMPERATURES
C DIMENSION: DATA-BLOCK INDEX
C OUTPUT: (I*4) ITDA() = READ - NUMBER OF DONOR TEMPERATURES
C DIMENSION: DATA-BLOCK INDEX
C
C OUTPUT: (R*8) TFRA(,) = READ - RECEIVER TEMPERATURES (UNITS: EV)
C 1ST DIMENSION: RECEIVER TEMPERATURE INDEX
C 2ND DIMENSION: DATA-BLOCK INDEX
C OUTPUT: (R*8) TFDA(,) = READ - DONOR TEMPERATURES (UNITS: EV)
C 1ST DIMENSION: DONOR TEMPERATURE INDEX
C 2ND DIMENSION: DATA-BLOCK INDEX
C
C OUTPUT: (R*8) QFTEQA(,)= READ - EQUAL TEMPERATURE RATE-COEFFICIENTS
C (UNITS: CM**3 SEC-1)
C 1ST DIMENSION: RECEIVER TEMPERATURE INDEX
C 2ND DIMENSION: DATA-BLOCK INDEX
C OUTPUT: (R*8) QFTCXA(,,)=READ - FULL SET OF RATE-COEFFICIENTS
C (UNITS: CM**3 SEC-1)
C 1ST DIMENSION: DONOR TEMPERATURE INDEX
C 2ND DIMENSION: RECEIVER TEMPERATURE INDEX
C 3RD DIMENSION: DATA-BLOCK INDEX
C
C (C*2) CEQUAL = PARAMETER = 'EQ'
C
C (I*4) I4EIZ0 = FUNCTION - (SEE ROUTINES SECTION BELOW)
C (I*4) I4FCTN = FUNCTION - (SEE ROUTINES SECTION BELOW)
C (I*4) I4UNIT = FUNCTION - (SEE ROUTINE SECTION BELOW)
C (I*4) IBLK = ARRAY INDEX: DATA-BLOCK INDEX
C (I*4) ITR = ARRAY INDEX: RECEIVER TEMPERATURE INDEX
C (I*4) ITD = ARRAY INDEX: DONOR TEMPERATURE INDEX
C (I*4) NTRNUM = NUMBER OF RECEIVER TEMPERATURES FOR CURRENT
C DATA-BLOCK
C (I*4) NTDNUM = NUMBER OF DONOR TEMPERATURES FOR CURRENT
C DATA-BLOCK
C (I*7) N7 = MIN(7,NDTNUM) REQUIRED TO HANDLE > 7 DONOR TEMPS
C (I*4) IABT = RETURN CODE FROM 'I4FCTN'
C
C (L*4) LBEND = IDENTIFIES WHETHER THE LAST OF THE INPUT
C DATA SUB-BLOCKS HAS BEEN LOCATED.
C (.TRUE. => END OF SUB-BLOCKS REACHED)
C
C (C*10) IONNAM = READ - DONOR/RECEIVER DESIGNATION STRING
C
C (C*1) CSLASH = '/' - DELIMITER FOR 'XXHKEY'
C (C*2) C2 = GENERAL USE TWO BYTE CHARACTER STRING
C (C*3) CKEY1 = 'AMD' - INPUT BLOCK HEADER KEY
C (C*3) CKEY2 = 'AMR' - INPUT BLOCK HEADER KEY
C (C*3) CKEY3 = 'FST' - INPUT BLOCK HEADER KEY
C (C*4) CKEY4 = 'ISEL' - INPUT BLOCK HEADER KEY
C (C*80) C80 = GENERAL USE 80 BYTE CHARACTER STRING FOR
C THE INPUT OF DATA-SET RECORDS.
C (C*80) C80 = GENERAL USE 80 BYTE CHARACTER STRING FOR
C THE INPUT OF DATA-SET RECORDS.
C
C ROUTINES:
C ROUTINE SOURCE BRIEF DESCRIPTION
C ------------------------------------------------------------
C XXHKEY ADAS OBTAIN KEY/RESPONSE STRINGS FROM TEXT
C I4EIZ0 ADAS INTEGER*4 FUNCTION -
C RETURNS Z0 FOR GIVEN ELEMENT SYMBOL
C I4FCTN ADAS INTEGER*4 FUNCTION -
C CONVERT CHARACTER STRING TO INTEGER
C R8FCTN ADAS REAL*8 FUNCTION -
C CONVERT CHARACTER STRING TO REAL
C I4UNIT ADAS INTEGER*4 FUNCTION -
C FETCH UNIT NUMBER FOR OUTPUT OF MESSAGES
C
C AUTHOR: PAUL E. BRIDEN (TESSELLA SUPPORT SERVICES PLC)
C K1/0/81
C JET EXT. 4569
C
C DATE: 20/02/91
C
C UPDATE: 23/04/93 - PE BRIDEN - ADAS91: ADDED I4UNIT FUNCTION TO WRITE
C STATEMENTS FOR SCREEN MESSAGES
C
C UPDATE: 24/05/93 - PE BRIDEN - ADAS91: CHANGED I4UNIT(0)-> I4UNIT(-1)
C
C UPDATE: 15/12/95 - HP SUMMERS- ADAS91: MODIFIED INFOMATION STRING USE
C
C UNIX-IDL PORT:
C
C AUTHOR: WILLIAM OSBORN (TESSELLA SUPPORT SERVICES PLC)
C NO CHANGES FROM IBM VERSION
C
C DATE: 20TH MARCH 1996
C
C VERSION: 1.1 DATE: 20-03-96
C MODIFIED: WILLIAM OSBORN
C - FIRST VERSION
C
C VERSION: 1.2 DATE: 10-04-96
C MODIFIED: WILLIAM OSBORN
C - REMOVED REDUNDANT VARIABLE
C
C VERSION: 1.3 DATE: 19-09-97
C MODIFIED: MARTIN O'MULLANE
C - MODIFIED TO ALLOW DATASETS WITH GREATER THAN 7 DONOR
C TEMPERATURES TO BE USED.
C
C-----------------------------------------------------------------------
CHARACTER*9 CDONOR(NSTORE)
CHARACTER*10 CFSTAT(NSTORE)
CHARACTER*9 CRECVR(NSTORE)
CHARACTER*44 DSNAME
INTEGER IDZ0(NSTORE), IRZ0(NSTORE)
INTEGER IRZ1(NSTORE), ISELA(NSTORE)
INTEGER ITDA(NSTORE), ITRA(NSTORE)
INTEGER IUNIT, NBSEL, NSTORE, NTDDIM
INTEGER NTRDIM
LOGICAL LEQUA(NSTORE)
REAL*8 AMSDA(NSTORE), AMSRA(NSTORE)
REAL*8 QFTCXA(NTDDIM,NTRDIM,NSTORE)
REAL*8 QFTEQA(NTRDIM,NSTORE), TFDA(NTDDIM,NSTORE)
REAL*8 TFRA(NTRDIM,NSTORE)