ADAS Subroutine nsuph1
SUBROUTINE NSUPH1(TEV,EBEAM,TIEV,NIMP ,ZIMPA ,FRIMPA,AMIMPA,
& ITYP1 ,ITYP2 ,ITYP3 ,ITYP4 ,ITYP5 ,ITYP6 ,
& XTBE ,XTBP ,XTBZ ,STBE ,STBP ,STBZ ,
& LXTBE ,LXTBP ,LXTBZ ,LSTBE ,LSTBP ,LSTBZ ,
& PXTBE ,PXTBP ,PXTBZ ,PSTBE ,PSTBP ,PSTBZ ,
& LPXTBE,LPXTBP,LPXTBZ,LPSTBE,LPSTBP,LPSTBZ,
& DSLPATH)
C
IMPLICIT REAL*8(A-H,O-Z)
C
C-----------------------------------------------------------------------
C
C ****************** FORTRAN77 SUBROUTINE: NSUPH1 *********************
C-----------------------------------------------------------------------
C PURPOSE: ACCESS SPECIFIC HIGHER QUALITY DATA FOR HYDROGEN
C
C POPULATION STRUCTURE CALCULATION IN THE BUNDLE-N APPROXIMATION.
C
C DATA TYPES ARE:
C
C (1) ELECTRON IMPACT EXCITATION - SPECIFIC ION FILE IS OPENED.
C (2) ELECTRON IMPACT IONISATION - SPECIFIC FIT IS USED.
C (3) H+ IMPACT EXCITATION - QHIEXDAT FILE IS OPENED.
C (4) H+ IMPACT IONIS + CX - QHIEXDAT FILE IS OPENED.
C (5) ZIMP ION IMPACT EXCITATION - QHIEXDAT FILE IS OPENED.
C (6) ZIMP ION IMPACT IONIS + CX - QHIEXDAT FILE IS OPENED.
C
C INPUT
C TEV = ELECTRON TEMPERATURE (EV)
C EBEAM = BEAM ENERGY (EV/AMU) USED AS A UNIFORM VELOCITY SHIFT
C FOR ION COLLISIONS
C TIEV = ION TEMPERATURE (EV)
C NIMP = NUMBER OF IMPURITY IONS (EXCLUDING H+)
C ZIMPA() = Z OF EFFECTIVE IMPURITY FOR ION COLLISIONS(EXCEPT H+)
C FRIMPA() = FRACTION OF TOTAL IMPURITY NUMBER DENSITY (EXCL H+)
C AMIMPA() = ATOMIC MASS NUMBER OF IMPURITY
C ITYP1 = 0 DO NOT OBTAIN TYPE 1 DATA
C = 1 OBTAIN TYPE 1 DATA
C ITYP2 = 0 DO NOT OBTAIN TYPE 2 DATA
C = 1 OBTAIN TYPE 2 DATA
C ITYP3 = 0 DO NOT OBTAIN TYPE 3 DATA
C = 1 OBTAIN TYPE 3 DATA
C ITYP4 = 0 DO NOT OBTAIN TYPE 4 DATA
C = 1 OBTAIN TYPE 1 DATA
C ITYP5 = 0 DO NOT OBTAIN TYPE 5 DATA
C = 1 OBTAIN TYPE 2 DATA
C ITYP6 = 0 DO NOT OBTAIN TYPE 6 DATA
C = 1 OBTAIN TYPE 3 DATA
C DSLPATH = STRING CONTAINING PATH FOR INPUT FILE FOR UNIT 15
C
C OUTPUT
C XTBE(N,N'') = TYPE 1 RATE COEFFICIENT
C XTBP(N,N'') = TYPE 3 RATE COEFFICIENT
C XTBZ(N,N'') = TYPE 5 RATE COEFFICIENT
C STBE(N) = TYPE 2 RATE COEFFICIENT
C STBP(N) = TYPE 4 RATE COEFFICIENT
C STBZ(N) = TYPE 6 RATE COEFFICIENT
C LXTBE(N,N'') = TYPE 1 MARKER (0 =NO VALUE, 1=VALUE)
C LXTBP(N,N'') = TYPE 3 MARKER
C LXTBZ(N,N'') = TYPE 5 MARKER
C LSTBE(N) = TYPE 2 MARKER
C LSTBP(N) = TYPE 4 MARKER
C LSTBZ(N) = TYPE 6 MARKER
C PXTBE(N) = TYPE 1 PROJECTION MULTIPLIER
C PXTBP(N) = TYPE 3 PROJECTION MULTIPLIER
C PXTBZ(N) = TYPE 5 PROJECTION MULTIPLIER
C PSTBE = TYPE 2 PROJECTION MULTIPLIER
C PSTBP = TYPE 4 PROJECTION MULTIPLIER
C PSTBZ = TYPE 6 PROJECTION MULTIPLIER
C LPXTBE(N) = TYPE 1 PROJECTION MULTIPLIER USED ABOVE THIS N'
C LPXTBP(N) = TYPE 3 PROJECTION MULTIPLIER USED ABOVE THIS N'
C LPXTBZ(N) = TYPE 5 PROJECTION MULTIPLIER USED ABOVE THIS N'
C LPSTBE = TYPE 2 PROJECTION MULTIPLIER USED ABOBE THIS N
C LPSTBP = TYPE 4 PROJECTION MULTIPLIER USED ABOVE THIS N
C LPSTBZ = TYPE 6 PROJECTION MULTIPLIER USED ABOBE THIS N
C
C ********** H.P. SUMMERS, JET 9 MAY 1990 ***********
C ********** 20 JUL 1990 ***********
C ********** 13 AUG 1990 ***********
C ********** NEW ELECTRON EXCIT. DATA 22 JAN 1991 ***********
C ********** NEW ION IMPACT EXCIT. DATA 3 JUL 1991 ***********
C ********** NEW ELEC. IMPACT ION. DATA 3 JUL 1991 ***********
C ********** DATA EXTENSION BY ADDING 1 MAR 1992 ***********
C SOME INTERMEDIATE VALUES +
C ADDITION OF B, N, NE ION. +
C CHARGE EXCHANGE.
C ********** MULTIPLE, SIMULTANEOUS 11 JAN 1994 ***********
C IMPURITY EXTENSION
C ERROR CORRECTED IN IMPURITY
C REDUCED MASSES
C-----------------------------------------------------------------------
C
C-----------------------------------------------------------------------
C
C UPDATE: 19/01/94 - JONATHAN NASH - TESSELLA SUPPORT SERVICES PLC
C
C THE FOLLOWING MODIFICATIONS HAVE BEEN MADE TO THE SUBROUTINE:
C
C 1) A PARAMETER FLAG HAS BEEN ADDED TO SWITCH ON/OFF
C DIAGNOSTIC PRINTING (UNIT 6).
C
C NOTES: NO ATTEMPT HAS BEEN MADE TO RESTRUCTURE THE ROUTINE. RATHER
C THE MINIMUM AMOUNT OF WORK TO INTEGRATE THE ROUTINE INTO
C ADAS310 HAS BEEN COMPLETED.
C
C UNIX-IDL PORT:
C
C VERSION: 1.1 DATE: 16-1-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - FIRST VERSION
C
C VERSION: 1.2 DATE: 18-1-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - ADDED VARIABLE DSLPATH AND CHANGED NAME OF INPUT FILE
C
C VERSION: 1.3 DATE: 18-1-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - CORRECTED STRING HANDLING SYNTAX IN CONSTRUCTION OF
C DSNAME, COMMENTED OUT REFERENCES TO DEBUG LOGICAL
C VARIABLE AND INSERTED 'CALL' BEFORE XXSLEN.
C
C VERSION: 1.4 DATE: 18-1-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - MODIFIED CONSTRUCTION OF DSNAME
C
C VERSION: 1.5 DATE: 18-1-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - ADDED DSLPATH IN CALL TO QH.FOR
C
C VERSION: 1.6 DATE: 22-1-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - REPLACED CALLS TO NAG ROUTINE E02BBF WITH ADAS ROUTINE
C DXNBBF
C
C VERSION: 1.7 DATE: 23-1-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - REPLACED CALLS TO NAG ROUTINE E01BAF WITH ADAS ROUTINE
C DXNBAF
C
C VERSION: 1.8 DATE: 08-02-96
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - REMOVED SUPERFLUOUS VARIABLES
C
C VERSION: 1.9 DATE: 03-04-97
C MODIFIED: H.ANDERSON
C - ALTERED TO USE RESTRUCTURED ADF02 DATASET sia#h_rfm.dat
C
C VERSION: 1.10 DATE: 03/04/97
C MODIFIED: HARVEY ANDERSON.
C ALTERED TO USE NEW PREFERRED ADF02 DATASET sia#h_j97.dat
C
C VERSION: 1.11 DATE: 08-04-97
C MODIFIED: RICHARD MARTIN
C CHANGED NAME OF ADF02 FILE FROM sia#h_j97.dat TO
C sia#h_j97#h.dat
C
C VERSION: 1.12 DATE: 23-02-99
C MODIFIED: HARVEY ANDERSON
C ADDED ADDITIONAL CODE TO ACCESS THE FUNDAMENTAL DATA
C FOR ARGON WHICH IS CONTAINED IN THE ADF02 TYPE FILE.
C
C
C VERSION : 1.13 DATE: 20-10-2003
C MODIFIED: Martin O'Mullane
C - Extend TITLX to 120 to match e2titl routine.
C
C VERSION: 1.14 DATE: 07-07-2004
C MODIFIED: Allan Whiteford
C - Changed calls from DXNB{A,B}F TO XXNB{A,B}F
C
C VERSION: 1.15 DATE: 07-07-2004
C MODIFIED: Allan Whiteford
C - Updated comments as part of subroutine documentation
C procedure.
C
C-----------------------------------------------------------------------
C
C PARAM : (L*4) DEBUG = FLAGS DIAGNOSTIC PRINTING.
C .TRUE. => PRINT DIAGNOSTICS.
C .FALSE. => DO NOT PRINT DIAGNOSTICS.
C
C-----------------------------------------------------------------------
C
C-----------------------------------------------------------------------
LOGICAL DEBUG
CHARACTER*80 DSLPATH
INTEGER ITYP1, ITYP2, ITYP3, ITYP4
INTEGER ITYP5, ITYP6, LPSTBE, LPSTBP
INTEGER LPSTBZ, LPXTBE(NDLOW)
INTEGER LPXTBP(NDLOW), LPXTBZ(NDLOW)
INTEGER LSTBE(NDLOW), LSTBP(NDLOW)
INTEGER LSTBZ(NDLOW), LXTBE(NDLOW,NDLOW)
INTEGER LXTBP(NDLOW,NDLOW), LXTBZ(NDLOW,NDLOW)
INTEGER NIMP
REAL*8 AMIMPA(10), EBEAM, FRIMPA(10), PSTBE
REAL*8 PSTBP, PSTBZ, PXTBE(NDLOW)
REAL*8 PXTBP(NDLOW), PXTBZ(NDLOW)
REAL*8 STBE(NDLOW), STBP(NDLOW), STBZ(NDLOW), TEV
REAL*8 TIEV, XTBE(NDLOW,NDLOW)
REAL*8 XTBP(NDLOW,NDLOW), XTBZ(NDLOW,NDLOW)
REAL*8 ZIMPA(10)