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)