ADAS Subroutine d5spow
SUBROUTINE D5SPOW( LSELA , LEXSA , LDEFA , LPART , LEXSS ,
& IZ0 , IZL , IZH , NPART ,
& ISDIMD , IZDIMD , ITDIMD , IPDIMD , IMDIMD ,
& ACDA , SCDA , CCDA , PRBA ,
& PRCA , QCDA , XCDA , PLTA ,
& NMSUM , IZIP , IMIP , IPIZM ,
& NTDIM , ITMAX ,
& DENS , DENSH ,
& FPABUN , FSABUN ,
& PLTPEQ ,
& ACDSEQ , SCDSEQ , CCDSEQ , PRBSEQ ,
& PRCSEQ , PLTSEQ ,
& PRBEQ , PRCEQ , PLTEQ , PRADA
& )
C
C-----------------------------------------------------------------------
C
C ****************** FORTRAN77 SUBROUTINE: D5SPOW *********************
C
C PURPOSE : TO ASSEMBLE RADIATED POWER FUNCTIONS USING FRACTIONAL
C METASTABLE ABUNDANCES.
C GENERATE STANDARD ISONUCLEAR MASTER DATA FROM PARTIAL DATA.
C
C NOTE : THE SOURCE ISONUCLEAR MASTER FILE DATA ARE OBTAINED BY A
C PRIOR CALL TO SUBROUTINE D5DATA FROM SEQUENTIAL FILES
C WITH THE FOLLOWING NAMING CONVENTIONS:
C
C (1) JETSHP.ACD<YR>#<EL).<CODE>DATA
C (2) JETSHP.SCD<YR>#<EL>.<CODE>DATA
C (3) JETSHP.CCD<YR>#<EL>.<CODE>DATA
C (4) JETSHP.PRB<YR>#<EL>.<FILT>.<CODE>DATA
C (5) JETSHP.PRC<YR>#<EL>.<FILT>.<CODE>DATA
C (6) JETSHP.QCD<YR>#<EL>.<CODE>DATA
C (7) JETSHP.XCD<YR>#<EL>.<CODE>DATA
C (8) JETSHP.PLT<YR>#<EL>.<CODE>DATA
C
C WHERE, <YR> = TWO DIGIT YEAR NUMBER
C <EL> = ONE OR TWO CHARACTER ELEMENT SYMBOL
C <CODE> = R => PARTIAL DATA
C U => PARTIAL DATA
C OMITTED => STANDARD DATA
C <FILT> = SIX CHARACTER POWER FILTER CODE
C
C AND DATA OF CLASSES 6 AND 7 DO NOT EXIST FOR THE PARTIAL CASE.
C
C
C INPUT : (L*4) LSELA() = .TRUE. => INPUT DATA SET TYPE FOR THIS
C INDEX SELECTED
C = .FALSE. => INPUT DATA SET FOR THIS INDEX
C NOT SELECTED
C INPUT : (L*4) LEXSA() = .TRUE. => INPUT DATA SET TYPE FOR THIS
C SELECTED INDEX EXISTS
C = .FALSE. => INPUT DATA SET DOES NOT EXIST
C FOR THIS SELECTED INDEX
C INPUT : (L*4) LDEFA() = .TRUE. => INPUT DATA SET TYPE FOR THIS
C DEFAULT YEAR INDEX EXISTS
C = .FALSE. => INPUT DATA SET DOES NOT EXIST
C FOR THIS DEFAULT YEAR INDEX
C INPUT : (L*4) LPART = .TRUE. => PARTIAL DATA SELECTED
C = .FALSE. => STANDARD DATA SELECTED
C INPUT : (I*4) IZ0 = NUCLEAR CHARGE
C INPUT : (I*4) IZL = MINIMUM ION CHARGE+1 IN MASTER DATA FILES
C INPUT : (I*4) IZH = MAXIMUM ION CHARGE+1 IN MASTER DATA FILES
C INPUT : (I*4) NPART() = METASTABLE PARTITION. I.E. NUMBER OF
C METASTABLES FROM CHARGE STATE IZL-1 TO
C IZH ON INPUT
C INPUT : (I*4) ISDIMD = MAXIMUM NUMBER OF (CHARGE, PARENT, GROUND)
C BLOCKS IN ISONUCLEAR MASTER FILES
C INPUT : (I*4) IZDIMD = MAXIMUM NUMBER OF CHARGE STATES
C IN ISONUCLEAR MASTER FILES
C INPUT : (I*4) ITDIMD = MAXIMUM NUMBER OF TEMP OR DENS VALUES IN
C ISOELECTRONIC MASTER FILES
C INPUT : (I*4) IPDIMD = MAXIMUM NUMBER OF METASTABLES FOR EACH
C IONISATION STAGE
C INPUT : (I*4) IMDIMD = MAXIMUM NUMBER OF METASTABLES
C
C INPUT : (R*8) ACDA(,,,) = INTERPOLATION OF ACD COEFFICIENT (CM3 S-1)
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: CHARGE STATE INDEX
C 3RD DIM: RECOMBINING METASTABLE INDEX
C 4TH DIM: RECOMBINED METASTABLE INDEX
C INPUT : (R*8) SCDA(,,,) = INTERPOLATION OF SCD COEFFICIENT (CM3 S-1)
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: CHARGE STATE INDEX
C 3RD DIM: RECOMBINING METASTABLE INDEX
C 4TH DIM: RECOMBINED METASTABLE INDEX
C INPUT : (R*8) CCDA(,,,) = INTERPOLATION OF CCD COEFFICIENT (CM3 S-1)
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: CHARGE STATE INDEX
C 3RD DIM: RECOMBINING METASTABLE INDEX
C 4TH DIM: RECOMBINED METASTABLE INDEX
C INPUT : (R*8) PRBA(,,) = INTERPOLATION OF PRB COEFFICIENT (W CM3 )
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: CHARGE STATE INDEX
C 3RD DIM: RECOMBINING METASTABLE INDEX
C INPUT : (R*8) PRCA(,,) = INTERPOLATION OF PRC COEFFICIENT (W CM3 )
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: CHARGE STATE INDEX
C 3RD DIM: RECOMBINING METASTABLE INDEX
C INPUTT : (R*8) QCDA(,,,) = INTERPOLATION OF QCD COEFFICIENT (CM3 S-1)
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: CHARGE STATE INDEX
C 3RD DIM: FIRST METASTABLE INDEX
C 4TH DIM: SECOND METASTABLE INDEX
C INPUT : (R*8) XCDA(,,,) = INTERPOLATION OF XCD COEFFICIENT (CM3 S-1)
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: CHARGE STATE INDEX
C 3RD DIM: FIRST PARENT METASTABLE INDEX
C 4TH DIM: SECOND PARENT METASTABLE INDEX
C INPUT : (R*8) PLTA(,,) = INTERPOLATION OF PLT COEFFICIENT (W CM3 )
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: CHARGE STATE INDEX
C 3RD DIM: METASTABLE INDEX
C INPUT : (I*4) NMSUM = TOTAL NUMBER OF POPULATIONS
C
C INPUT : IZIP() = ION CHARGE +1 (IZ1) OF METASTABLE IN LIST
C INPUT : IMIP() = METASTABLE INDEX WITHIN CHARGE STATE IZ1
C OF METASTABLE INDEX FROM COMPLETE LIST
C INPUT : IPIZM(,) = METASTABLE INDEX IN COMPLETE LIST
C 1ST DIM: INDEX IZ1-IZL+1
C 2ND DIM: METASTABLE COUNT FOR STAGE (IGRD)
C INPUT : (I*4) NTDIM = MAXIMUM NUMBER OF DTEV/DDENS PAIRS
C INPUT : (I*4) ITMAX = NUMBER OF ( DTEV() , DDENS() ) PAIRS
C INPUT : (R*8) DENS() = ELECTRON DENSITIES (CM-3))
C INPUT : (R*8) DENSH() = HYDROGEN DENSITIES (CM-3))
C INPUT : (R*8) FPABUN(,) = RESOLVED METASTABLE EQUILIBRIUM
C FRACTIONAL ABUNDANCES
C 1ST DIM: - TEMPERATURE/DENSITY PAIR
C 2ND DIM: - METASTABLE INDEX
C OUTPUT : (L*4) LEXSS() = .TRUE. => OUTPUT STANDARD MASTER DATA FOR
C THIS INDEX GENERATED
C = .FALSE. => OUTPUT STANDARD MASTER DATA FOR
C THIS INDEX NOT GENERATED
C OUTPUT : (R*8) FSABUN(,) = STAGE EQUILIBRIUM FRACTIONAL ABUNDANCES
C 1ST DIM: - TEMPERATURE/DENSITY PAIR INDEX
C 2ND DIM: - CHARGE STATE INDEX (IZ1-IZL+1)
C OUTPUT : (R*8) PLTPEQ(,) = METASTABLE PARTIAL EQUILIBRIUM RADIATED
C LINE POWER FUNCTIONS
C 1ST DIM: - TEMPERATURE/DENSITY PAIR
C 2ND DIM: - METASTABLE INDEX
C OUTPUT : (R*8) ACDSEQ(,) = STANDARD (UNRESOLVED) ACD COEFFICIENT
C 1ST DIM: - TEMPERATURE/DENSITY PAIR INDEX
C 2ND DIM: - CHARGE STATE INDEX (IZ1-IZL+1)
C OUTPUT : (R*8) SCDSEQ(,) = STANDARD (UNRESOLVED) SCD COEFFICIENT
C 1ST DIM: - TEMPERATURE/DENSITY PAIR INDEX
C 2ND DIM: - CHARGE STATE INDEX (IZ1-IZL+1)
C OUTPUT : (R*8) CCDSEQ(,) = STANDARD (UNRESOLVED) CCD COEFFICIENT
C 1ST DIM: - TEMPERATURE/DENSITY PAIR INDEX
C 2ND DIM: - CHARGE STATE INDEX (IZ1-IZL+1)
C OUTPUT : (R*8) PRBSEQ(,) = STANDARD (UNRESOLVED) SCD COEFFICIENT
C 1ST DIM: - TEMPERATURE/DENSITY PAIR INDEX
C 2ND DIM: - CHARGE STATE INDEX (IZ1-IZL+1)
C OUTPUT : (R*8) PRCSEQ(,) = STANDARD (UNRESOLVED) CCD COEFFICIENT
C 1ST DIM: - TEMPERATURE/DENSITY PAIR INDEX
C 2ND DIM: - CHARGE STATE INDEX (IZ1-IZL+1)
C OUTPUT : (R*8) PLTSEQ(,) = STANDARD (UNRESOLVED) CCD COEFFICIENT
C 1ST DIM: - TEMPERATURE/DENSITY PAIR INDEX
C 2ND DIM: - CHARGE STATE INDEX (IZ1-IZL+1)
C OUTPUT : (R*8) PRBEQ() = TOTAL EQUILIBRIUM RADIATED RECOM-BREMS
C POWER FUNCTION
C OUTPUT : (R*8) PRCEQ() = TOTAL EQUILIBRIUM CX RADIATED RECOM POWER
C FUNCTION NORMALISED TO ELECTRON
C DENSITY
C OUTPUT : (R*8) PLTEQ() = TOTAL EQUILIBRIUM RADIATED LINE POWER
C FUNCTION
C OUTPUT : (R*8) PRADA() = TOTAL EQUILIBRIUM RADIATED POWER FUNCTION
C
C PROGRAM: (I*4) IT = GENERAL INDEX FOR TEMPERATURE
C (I*4) IZ = GENERAL INDEX FOR CHARGE
C (I*4) IP = GENERAL INDEX FOR CHARGE
C (I*4) IZ1 = GENERAL INDEX FOR CHARGE+1
C (I*4) ICL = GENERAL INDEX FOR CLASS
C (I*4) IPP = GENERAL PARENT INDEX
C (I*4) IPG = GENERAL GROUND INDEX
C (I*4) IZREF = GENERAL CHARGE STAE POINTER INDEX
C (I*4) IPRT = GENERAL INDEX FOR PARENT METASTABLE
C (I*4) IGRD = GENERAL INDEX FOR METASTABLE
C
C
C ROUTINES:
C ROUTINE SOURCE BRIEF DESCRIPTION
C ------------------------------------------------------------
C
C
C AUTHOR : H. P. SUMMERS, JET
C K1/1/57
C JET EXT. 4941
C
C DATE : 28/04/94
C
C UNIX-IDL PORT:
C VERSION: 1.1 DATE: 31-10-95
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - INITIAL VERSION TO BE USED FOR UNIX PLATFORMS
C
C VERSION: 1.2 DATE: 08-11-95
C MODIFIED: TIM HAMMOND
C - ALTERED LINE 'IF(LEXSA(ICL).OR.LDEFA(ICL))' IN LOOP 1
C TO 'IF((LEXSA(ICL).OR.LDEFA(ICL)).AND.LSELA(ICL))' TO
C REFLECT WHETHER OR NOT THE USER HAS ACTUALLY SELECTED
C THIS PARTICULAR CLASS FOR INCLUSION.
C - TIDIED UP COMMENTS AND CODE
C
C VERSION: 1.3 DATE: 08-11-95
C MODIFIED: TIM HAMMOND
C - REMOVED SUPERFLUOUS VARIABLES
C
C-----------------------------------------------------------------------
INTEGER IMDIMD, IMIP(IMDIMD), IPDIMD
INTEGER IPIZM(IZDIMD,IPDIMD), ISDIMD, ITDIMD
INTEGER ITMAX, IZ0, IZDIMD, IZH
INTEGER IZIP(IMDIMD), IZL, NMSUM
INTEGER NPART(IZDIMD), NTDIM
LOGICAL LDEFA(8), LEXSA(8), LEXSS(8), LPART
LOGICAL LSELA(8)
REAL*8 ACDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 ACDSEQ(NTDIM,IZDIMD)
REAL*8 CCDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 CCDSEQ(NTDIM,IZDIMD), DENS(NTDIM)
REAL*8 DENSH(NTDIM), FPABUN(NTDIM,IMDIMD)
REAL*8 FSABUN(NTDIM,IZDIMD)
REAL*8 PLTA(NTDIM,IZDIMD,IPDIMD)
REAL*8 PLTEQ(NTDIM), PLTPEQ(NTDIM,IMDIMD)
REAL*8 PLTSEQ(NTDIM,IZDIMD), PRADA(NTDIM)
REAL*8 PRBA(NTDIM,IZDIMD,IPDIMD)
REAL*8 PRBEQ(NTDIM), PRBSEQ(NTDIM,IZDIMD)
REAL*8 PRCA(NTDIM,IZDIMD,IPDIMD)
REAL*8 PRCEQ(NTDIM), PRCSEQ(NTDIM,IZDIMD)
REAL*8 QCDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 SCDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 SCDSEQ(NTDIM,IZDIMD)
REAL*8 XCDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)