ADAS Subroutine b8wrmc
C
SUBROUTINE B8WRMC( IUNIT , IUNT14 , IUNT15 , IUNT16 , IUNT17 ,
& IUNT18 , IUNT19 , IUNT20 , IUNT21 ,
& IUNT22 , IUNT23 ,
& DSNINC , DSFULL , DSNEXP ,
& TITLED , DATE , USER ,
& NDLEV , NDTEM , NDDEN , NDMET ,
& LNORM , IZ , IZ0 , IZ1 ,
& IBSELA , BWNOA , PRTWTA ,
& IL , NMET , NORD , IMETR ,
& IA , ISA , ILA , XJA ,
& CSTRGA , WA ,
& MAXT , MAXD , TEVA , DENSA ,
& NPL , NPLR , NPL3 , NPLI , CPRTA ,
& LRSEL , LISEL , LHSEL , LIOSEL ,
& LPSEL , LZSEL , LNSEL , FVCRED ,
& FVRRED , FVIRED , FVHRED , FVIONR ,
& FVCRPR , PL , PH , PS , SWVLN ,
& PR ,
& RATPIA , RATMIA , STACK , STCKM ,
& LSSETA , LSS04A
& )
C-----------------------------------------------------------------------
C
C ******************** FORTRAN77 SUBROUTINE: B8WRMC ****************** *
C
C PURPOSE: TO OUTPUT DATA TO GENERALISED COLLISIONAL RADIATIVE
C COEFFICIENT PASSING FILE MASTER.PASS
C FINAL STORAGE IS EXPECTED TO BE IN MASTER CONDENSED FILES
C
C
C CALLING PROGRAM: ADAS208
C
C
C SUBROUTINE:
C
C INPUT : (I*4) IUNIT = OUTPUT UNIT NUMBER FOR GCR INFORMATION
C INPUT : (I*4) IUNT14 = OUTPUT UNIT NUMBER FOR ACD DATA
C INPUT : (I*4) IUNT15 = OUTPUT UNIT NUMBER FOR SCD DATA
C INPUT : (I*4) IUNT16 = OUTPUT UNIT NUMBER FOR CCD DATA
C INPUT : (I*4) IUNT17 = OUTPUT UNIT NUMBER FOR QCD DATA
C INPUT : (I*4) IUNT18 = OUTPUT UNIT NUMBER FOR XCD DATA
C INPUT : (I*4) IUNT19 = OUTPUT UNIT NUMBER FOR PRB DATA
C INPUT : (I*4) IUNT20 = OUTPUT UNIT NUMBER FOR PRC DATA
C INPUT : (I*4) IUNT21 = OUTPUT UNIT NUMBER FOR PLT DATA
C INPUT : (I*4) IUNT22 = OUTPUT UNIT NUMBER FOR PLS DATA
C INPUT : (I*4) IUNT23 = OUTPUT UNIT NUMBER FOR MET DATA
C INPUT : (C*80) DSNINC = INPUT COPASE DATA SET NAME (IN QUOTES).
C INPUT : (C*80) DSFULL = INPUT SZD DATA SET NAME (IN QUOTES).
C INPUT : (C*80) DSNEXP = INPUT EXPANSION FILE
C INPUT : (C*3) TITLED = ELEMENT SYMBOL.
C INPUT : (C*8) DATE = CURRENT DATE.
C INPUT : (C*30) USER = USER IDENTIFIER
C
C INPUT : (I*4) NDLEV = MAXIMUM NUMBER OF LEVELS ALLOWED
C INPUT : (I*4) NDTEM = MAXIMUM NUMBER OF TEMPERATURES ALLOWED
C INPUT : (I*4) NDDEN = MAXIMUM NUMBER OF DENSITIES ALLOWED
C INPUT : (I*4) NDMET = MAXIMUM NUMBER OF METASTABLES ALLOWED
C
C INPUT : (I*4) IZ = RECOMBINED ION CHARGE READ
C INPUT : (I*4) IZ0 = NUCLEAR CHARGE READ
C INPUT : (I*4) IZ1 = RECOMBINING ION CHARGE READ
C (NOTE: IZ1 SHOULD EQUAL IZ+1)
C INPUT : (I*4) IBSELA(,)=IONISATION DATA BLOCK SELECTOR INDICES
C 1ST DIMENSION - (Z) ION METASTABLE COUNT
C 2ND DIMENSION - (Z+1) ION METASTABLE COUNT
C INPUT : (R*8) BWNOA() = IONISATION POTENTIALS TO (Z+1) METAS.(CM-1)
C INPUT : (R*8) PRTWTA()= STATISTICAL WEIGHTS OF (Z+1) METASTABLES
C
C INPUT : (I*4) IL = NUMBER OF ENERGY LEVELS
C INPUT : (L*4) LNORM =.TRUE. => IF NMET=1 THEN VARIOUS
C IONISATION OUTPUT FILE
C NORMALISED TO STAGE TOT.POPULATN.
C (** NORM TYPE = T)
C =.FALSE. => OTHERWISE NORMALISE TO IDENTIFIED
C METASTABLE POPULATIONS.
C (** NORM TYPE = M)
C
C INPUT : (I*4) NMET = NUMBER OF METASTABLES LEVELS: 1<=NMET<=NDMET
C INPUT : (I*4) NORD = NUMBER OF ORDINARY LEVELS ('IL' - 'NMET')
C INPUT : (I*4) IMETR() = INDEX OF (Z) METAS. IN COMPLETE LEVEL LIST
C
C INPUT : (I*4) IA() = ENERGY LEVEL INDEX NUMBER
C INPUT : (I*4) ISA() = MULTIPLICITY FOR LEVEL 'IA()'
C NOTE: (ISA-1)/2 = QUANTUM NUMBER (S)
C INPUT : (I*4) ILA() = QUANTUM NUMBER (L) FOR LEVEL 'IA()'
C INPUT : (R*8) XJA() = QUANTUM NUMBER (J-VALUE) FOR LEVEL 'IA()'
C NOTE: (2*XJA)+1 = STATISTICAL WEIGHT
C INPUT : (R*8) WA() = ENERGY RELATIVE TO LEVEL 1 (CM-1)
C DIMENSION: LEVEL INDEX
C INPUT : (R*8) AA() = ELECTRON IMPACT TRANSITION: A-VALUE (SEC-1)
C
C INPUT : (R*8) SGRDA(,,)=GROUND & METASTABLE IONISATION RATE
C COEFFICIENTS FROM SZD FILES (CM3 SEC-1)
C 1ST DIMENSION: TEMPERATURE INDEX
C 2ND DIMENSION: (Z) ION METASTABLE INDEX
C 3RD DIMENSION: (Z+1) ION METASTABLE INDEX
C INPUT : (C*18) CSTRGA()= NOMENCLATURE/CONFIGURATION FOR LEVEL 'IA()'
C INPUT : (I*4) MAXT = NUMBER OF INPUT TEMPERATURES ( 1 -> 'NDTEM')
C INPUT : (I*4) MAXD = NUMBER OF INPUT DENSITIES ( 1 -> 'NDDEN')
C INPUT : (R*8) TEA() = ELECTRON TEMPERATURES (UNITS: KELVIN)
C INPUT : (R*8) DENSA() = ELECTRON DENSITIES (UNITS: CM-3)
C
C INPUT : (I*4) NPL = NO. OF METASTABLES OF (Z+1) ION ACCESSED
C BY EXCITED STATE IONISATION IN COPASE
C FILE WITH IONISATION POTENTIALS GIVEN
C ON THE FIRST DATA LINE
C INPUT : (I*4) NPLR = NO. OF ACTIVE METAS. FOR RECOM OF (Z+1) ION
C INPUT : (I*4) NPL3 = NO. OF ACTIVE METAS. FOR RE+3B OF (Z+1) ION
C INPUT : (I*4) NPLI = NO. OF ACTIVE METASTABLES OF (Z-1) ION
C
C INPUT : (L*4) LRSEL = .TRUE. - RECOMB OF (Z+1) ION ACTIVE
C .FALSE. - RECOMB. OF (Z+1) ION INACTIVE
C INPUT : (L*4) LISEL = .TRUE. - IONIS. OF (Z-1) ION ACTIVE
C .FALSE. - IONIS. OF (Z-1) ION INACTIVE
C INPUT : (L*4) LHSEL = .TRUE. - CX REC. OF (Z+1) ION ACTIVE
C .FALSE. - CX REC. OF (Z+1) ION INACTIVE
C INPUT : (L*4) LIOSEL = .TRUE. - IONIS. OF (Z) ION ACTIVE
C .FALSE. - IONIS. OF (Z) ION INACTIVE
C INPUT : (L*4) LPSEL = .TRUE. => INCLUDE PROTON COLLISIONS
C = .FALSE. =>DO NOT INCLUDE PROTON COLLISIONS
C INPUT : (L*4) LZSEL = .TRUE. => SCALE PROTON COLLISIONS WITH
C PLASMA Z EFFECTIVE'ZEFF'.
C = .FALSE. => DO NOT SCALE PROTON COLLISIONS
C WITH PLASMA Z EFFECTIVE 'ZEFF'.
C (ONLY USED IF 'LPSEL=.TRUE.')
C INPUT : (L*4) LNSEL = .TRUE. => INCLUDE PROJECTED BUNDLE-N DATA
C FROM DATAFILE IF AVAILABLE
C = .FALSE. => DO NOT INCLUDE PROJECTED
C BUNDLE-N DATA
C
C INPUT : (R*8) FVCRED(,,,) = (Z)-(Z) CROSS GEN. COLL. RAD. COEFFTS.
C 1ST DIMENSION: (Z) METASTABLE INDEX
C 2ND DIMENSION: (Z) METASTABLE INDEX
C 3RD DIMENSION: TEMPERATURE INDEX
C 4TH DIMENSION: DENSITY INDEX
C INPUT : (R*8) FVRRED(,,,) = (Z+1)-(Z) RECOM GEN. COLL. RAD. COEFFTS.
C 1ST DIMENSION: (Z) METASTABLE INDEX
C 2ND DIMENSION: (Z+1) METASTABLE INDEX
C 3RD DIMENSION: TEMPERATURE INDEX
C 4TH DIMENSION: DENSITY INDEX
C INPUT : (R*8) FVIRED(,,,) = (Z-1)-(Z) IONIS GEN. COLL. RAD. COEFFTS.
C 1ST DIMENSION: (Z) METASTABLE INDEX
C 2ND DIMENSION: (Z-1) METASTABLE INDEX
C 3RD DIMENSION: TEMPERATURE INDEX
C 4TH DIMENSION: DENSITY INDEX
C INPUT : (R*8) FVHRED(,,,) = (Z+1)-(Z) CX R. GEN. COLL. RAD. COEFFTS.
C 1ST DIMENSION: (Z) METASTABLE INDEX
C 2ND DIMENSION: (Z+1) METASTABLE INDEX
C 3RD DIMENSION: TEMPERATURE INDEX
C 4TH DIMENSION: DENSITY INDEX
C INPUT : (R*8) FVIONR(,,,) = (Z)-(Z+1) IONIS GEN. COLL. RAD. COEFFTS.
C 1ST DIMENSION: (Z) METASTABLE INDEX
C 2ND DIMENSION: (Z+1) METASTABLE INDEX
C 3RD DIMENSION: TEMPERATURE INDEX
C 4TH DIMENSION: DENSITY INDEX
C INPUT : (R*8) FVCRPR(,,,) = (Z+1)-(Z+1) CROSS COLL. RAD. COEFFTS.
C 1ST DIMENSION: (Z+1) METASTABLE INDEX
C FINAL STATE
C 2ND DIMENSION: (Z+1) METASTABLE INDEX
C INITIAL STATE
C 3RD DIMENSION: TEMPERATURE INDEX
C 4TH DIMENSION: DENSITY INDEX
C INPUT : (R*8) PL(,,) = TOTAL LINE POWER COEFFICIENTS
C 1ST DIMENSION: (Z) METASTABLE INDEX
C 2ND DIMENSION: TEMPERATURE INDEX
C 3RD DIMENSION: DENSITY INDEX
C UNITS: ERG SEC-1
C INPUT : (R*8) PH(,,) = CX RECOMBINATION POWER COEFFICIENTS
C 1ST DIMENSION: TEMPERATURE INDEX
C 2ND DIMENSION: DENSITY INDEX
C 3RD DIMENSION: (Z+1) PARENT METAS. INDEX
C UNITS: ERG SEC-1
C INPUT : (R*8) PS(,,,) = SPECIFIC LINE POWER COEFFICIENTS
C 1ST DIMENSION: METASTABLE LINE INDEX
C 2ND DIMENSION: (Z) METASTABLE INDEX
C 3RD DIMENSION: TEMPERATURE INDEX
C 4TH DIMENSION: DENSITY INDEX
C UNITS: ERG SEC-1
C INPUT : (R*8) SWVLN() = WAVELENGTHS (ANGSTROM) OF SPECIFIC LINES
C 1ST DIMENSION: METASTABLE LINE INDEX
C INPUT : (R*8) PR(,,) = RECOM/BREMS. COEFFT (ERG S-1)
C 1ST DIM: PARENT INDEX
C 2ND DIM: TEMPERATURE INDEX
C 3RD DIM: DENSITY INDEX
C INPUT : (R*8) RATPIA(,) = RATIO ( N(Z+1)/N(Z) STAGE ABUNDANCIES )
C 1ST DIMENSION: TEMP/DENS INDEX
C 2ND DIMENSION: PARENT INDEX
C INPUT : (R*8) RATMIA(,) = RATIO ( N(Z-1)/N(Z) STAGE ABUNDANCIES )
C 1ST DIMENSION: TEMP/DENS INDEX
C 2ND DIMENSION: PARENT INDEX
C
C INPUT : (R*4) STACK(,,,)= POPULATION DEPENDENCE
C 1ST DIMENSION: ORDINARY LEVEL INDEX
C 2ND DIMENSION: METASTABLE INDEX
C 3RD DIMENSION: TEMPERATURE INDEX
C 4TH DIMENSION: DENSITY INDEX
C INPUT : (R*8) STCKM(,,) = METASTABLE POPULATIONS STACK
C 1st DIMENSION: METASTABLE INDEX
C 2nd DIMENSION: TEMPERATURE INDEX
C 3rd DIMENSION: DENSITY INDEX
C INPUT : (L*4) LSSETA(,) = .TRUE. - MET. IONIS RATE SET IN B8GETS
C .FALSE.- MET. IONIS RATE NOT SET IN B8GETS
C 1ST DIMENSION: (Z) ION METASTABLE INDEX
C 2ND DIMENSION: (Z+1) ION METASTABLE INDEX
C INPUT : (L*4) LSS04A(,) = .TRUE. => IONIS. RATE SET IN ADF04 FILE:
C .FALSE.=> NOT SET IN ADF04 FILE
C 1ST DIM: LEVEL INDEX
C 2ND DIM: PARENT METASTABLE INDEX
C
C (R*8) DE = ENERGY FOR TRANSITION ( CM-1)
C (IONIS. POT. FOR IONISATION COEFFTS.
C EXCIT. ENR. FOR EXCITATION COEFFTS.)
C
C (I*4) I = GENERAL USE
C (I*4) IP = GENERAL USE
C (I*4) J = GENERAL USE
C (I*4) K = GENERAL USE
C (I*4) L = GENERAL USE
C (R*8) Z1 = RECOMBINING ION CHARGE
C (R*8) DUM1 = GENERAL USE
C (R*8) DUM2 = GENERAL USE
C (R*8) DUM3 = GENERAL USE
C (R*8) TR() = REDUCED TEMPERATUTES ( TE(K) / Z1*Z1)
C (R*8) DR() = REDUCED DENSITIES ( NE/ Z1**7)
C (R*8) SUM() = GENERAL USE IN RENORMALISATION
C (R*8) FMULT() = GENERAL USE IN RENORMALISATION
C
C
C
C ROUTINES:
C ROUTINE SOURCE BRIEF DESCRIPTION
C ------------------------------------------------------------
C B8CORR ADAS 'FIXES' LOW TE PROBLEM IN REC. DATA
C B8WINF ADAS DETERMINES IONIS. SOURCE AND WRITES
C COMMENT BLOCK
C
C
C AUTHOR: H. P. SUMMERS
C K1/1/57
C JET EXT. 4941
C
C DATE: 24/06/92
C
C UPDATE: 13/08/93 HP SUMMERS - INCLUDE NORMALISING TO TOTALS WHEN
C (LNORM. AND.(NMET.EQ.1)
C***********************************************************************
C UNIX-IDL PORT:
C
C AUTHOR: DAVID H BROOKS, UNIVERSITY OF STRATHCLYDE
C
C DATE: UNKNOWN
C
C UPDATE: 04/03/96 HP SUMMERS - OUTPUT C-R DATA TO SEPARATE FILES
C INCLUDE METASTABLE FRACTION FILE
C USE IUNIT FOR INFORMATION.
C UPDATE: 03/05/96 DH BROOKS - CHANGED DSNINC & DSNEXP TO 80
C CHARACTERS. ALTERED FORMATS 1003
C & 2042 TO ACCOMODATE.
C UPDATE: 13/05/96 HP SUMMERS - CORRECT TITLE LINE ON QCD208.PASS
C FILE TO GIVE CORRECT JGRD, IGRD
C NAMES.
C UPDATE: 24/05/96 HP SUMMERS - ADDED SPECIFIC LINE DATA, PS AND
C SWVLN TO PARAMETER LIST
C UPDATE: 03/06/96 HP SUMMERS - ADDED CX RECOMBINATION DATA, PH
C
C UPDATE: 23/07/96 HP SUMMERS - TIDY UP NAMES IN OUTPUT FILES FOR
C CONSISTENCY
C
C
C UPDATE: 09/03/98 HP SUMMERS - ADDED PRB TO DATA PASSED FROM THE
C PROJECTION MATRICES AND GIVEN AS
C OUTPUT FROM ADAS208
C***********************************************************************
C PUT UNDER SCCS CONTROL:
C
C VERSION: 1.1 DATE: 10/05/96
C MODIFIED: WILLIAM OSBORN (TESSELLA SUPPORT SERVICES PLC)
C - FIRST PUT UNDER SCCS
C
C VERSION: 1.2 DATE: 13/05/96
C MODIFIED: WILLIAM OSBORN (TESSELLA SUPPORT SERVICES PLC)
C - INCREASED SIZE OF DSFULL TO 80
C
C VERSION: 1.3 DATE: 14-05-96
C MODIFIED: WILLIAM OSBORN
C REARRANGED ARGUMENTS TO STAY UNDER
C LIMIT OF 20 CONTINUATION CHARACTERS AT ARCETRI AND GARCHING
C
C VERSION: 1.4 DATE: 15-07-96
C MODIFIED: WILLIAM OSBORN
C ADDED HUGH'S CORRECTIONS DATED 13/05/96, 24/05/96 AND
C 03/06/96 ABOVE
C
C VERSION: 1.5 DATE: 30-09-96
C MODIFIED: WILLIAM OSBORN
C ADDED HUGH'S CORRECTIONS DATED 23/07/96 ABOVE
C
C VERSION: 1.6 DATE: 18/10/96
C MODIFIED: WILLIAM OSBORN (TESSELLA SUPPORT SERVICES PLC)
C - ADDED CHECK FOR INDEX2.EQ.0 IN STRING PROCESSING
C
C VERSION: 1.7 DATE: 01/12/97
C MODIFIED: RICHARD MARTIN
C - FIXED BUG IN WRITING OUT OF TEMPERATURES IN PLT208.PASS,
C PLS208.PASS & MET208.PASS
C
C VERSION: 1.8 DATE: 09/03/98
C MODIFIED: HUGH SUMMERS
C - ADDED PRB TO DATA PASSED FROM THE PROJECTION MATRICES
C AND GIVEN AS OUTPUT FROM ADAS208.
C
C VERSION: 1.9 DATE: 2/09/99
C MODIFIED: Martin O'Mullane
C - Pass in real name of author rather than uid.
C - Removed nulls on output files
C - Changed delimeter from () to _. in getting FILEMEM
C - Incorrect logic in writing xcd files. Moved ENDIF to
C end of inner DO loop. Don't write info blocks for
C data which does not exist.
C - Wrong header written to xcd passing file. Replace IGRD
C with JPRT in the header line.
C - PRB output changed to write coefficient summed over
C spin systems.
C - Introduce b8corr to correct low Te problem
C in recombination coefficients.
C - Add source of ionisation data to comments with
C call to b8winf. This also tidies up writing of the
C comment block.
C
C VERSION: 1.10 DATE: 8/11/99
C MODIFIED: Martin O'Mullane
C - Write effective zeros for SCD, MET and XCD data.
C - Removed NDMET from call to b8winf
C
C-----------------------------------------------------------------------
CHARACTER*9 CPRTA(NDMET)
CHARACTER*18 CSTRGA(NDLEV)
CHARACTER*8 DATE
CHARACTER*80 DSFULL, DSNEXP, DSNINC
CHARACTER*3 TITLED
CHARACTER*30 USER
INTEGER IA(NDLEV), IBSELA(NDMET,NDMET), IL
INTEGER ILA(NDLEV), IMETR(NDMET)
INTEGER ISA(NDLEV), IUNIT, IUNT14, IUNT15
INTEGER IUNT16, IUNT17, IUNT18, IUNT19
INTEGER IUNT20, IUNT21, IUNT22, IUNT23
INTEGER IZ, IZ0, IZ1, MAXD
INTEGER MAXT, NDDEN, NDLEV, NDMET
INTEGER NDTEM, NMET, NORD, NPL
INTEGER NPL3, NPLI, NPLR
LOGICAL LHSEL, LIOSEL, LISEL, LNORM
LOGICAL LNSEL, LPSEL, LRSEL
LOGICAL LSS04A(NDLEV,NDMET), LSSETA(NDMET,NDMET)
LOGICAL LZSEL
REAL*8 BWNOA(NDMET), DENSA(NDDEN)
REAL*8 FVCRED(NDMET,NDMET,NDTEM,NDDEN)
REAL*8 FVCRPR(NDMET,NDMET,NDTEM,NDDEN)
REAL*8 FVHRED(NDMET,NDMET,NDTEM,NDDEN)
REAL*8 FVIONR(NDMET,NDMET,NDTEM,NDDEN)
REAL*8 FVIRED(NDMET,NDMET,NDTEM,NDDEN)
REAL*8 FVRRED(NDMET,NDMET,NDTEM,NDDEN)
REAL*8 PH(NDTEM,NDDEN,NDMET)
REAL*8 PL(NDMET,NDTEM,NDDEN)
REAL*8 PR(NDMET,NDTEM,NDDEN), PRTWTA(NDMET)
REAL*8 PS(NDMET,NDMET,NDTEM,NDDEN)
REAL*8 RATMIA(NDDEN,NDMET), RATPIA(NDDEN,NDMET)
REAL STACK(NDLEV,NDMET,NDTEM,NDDEN)
REAL*8 STCKM(NDMET,NDTEM,NDDEN), SWVLN(NDMET)
REAL*8 TEVA(NDTEM), WA(NDLEV), XJA(NDLEV)