ADAS Subroutine d5mpop
SUBROUTINE D5MPOP( NTDIM , IZDIMD, IPDIMD,
& NSTAGE, ITMAX , NPRT , NMSUM ,
& ACDA , SCDA , CCDA , QCDA , XCDA ,
& DENS , DENSH ,
& ITEM ,
& CFREC , CFION , CFMET ,
& POPN , POPNMO, POPNPO,
& CPOPN , CPOPND, CPOPNZ,
& POPF ,
& XTEMP , YTEMP , YTEM ,
& RHS , RDUM , SOLVE , LSOLVE
& )
IMPLICIT REAL*8(A-H,O-Z)
C
C-------------------------------------------------------------------------------
C ********
C ****************** FORTRAN 77 SUBROUTINE: D5MPOP ****************************
C
C PURPOSE: CALCULATION OF METASTABLE RESOLVED IONISATION STAGE
C POPULATIONS OF A PARTICULAR ELEMENT FOR A GIVEN TEMPERATURE
C AND DENSITY
C
C CALLING PROGRAM: ADAS405
C
C SUBROUTINE:
C
C
C INPUT :(I*4) NTDIM = MAXIMUM NUMBER OF MODEL TEMPS/DENSITIES
C INPUT :(I*4) IZDIMD = MAXIMUM NUMBER OF STAGES-1
C INPUT :(I*4) IPDIMD = MAXIMUM SIZE OF METASTABLES FRO A STAGE
C INPUT :(I*4) NSTAGE = NUMBER OF STAGES-1
C INPUT :(I*4) ITMAX = NUMBER OF MODEL TEMPS/DENSITIES
C INPUT :(R*8) NPRT( ) = PARTITION OF TOTAL METASTABLES ACCORDING
C TO IONISATION STAGES
C 1ST DIM: STAGE INDEX
C INPUT :(I*4) NMSUM = TOTAL NUMBER OF POPULATIONS
C INPUT :(R*8) ACDA(,,,) = GENERALISED CR RECOMBINATION COEFFICIENT
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: STAGE INDEX (LESS 1)
C 3RD DIM: METASTABLE INDEX
C 4TH DIM: METASTABLE INDEX
C INPUT :(R*8) SCDA(,,,) = GENERALISED CR IONISATION COEFFICIENT
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: STAGE INDEX (LESS 1)
C 3RD DIM: METASTABLE INDEX
C 4TH DIM: METASTABLE INDEX
C INPUT :(R*8) CCDA(,,,) = GENERALISED CR CHARGE EXCH. COEFFICIENT
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: STAGE INDEX (LESS 1)
C 3RD DIM: METASTABLE INDEX
C 4TH DIM: METASTABLE INDEX
C INPUT :(R*8) QCDA(,,,) = GENERALISED CR CROSS-COUPL. COEFFICIENT
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: STAGE INDEX (LESS 1)
C 3RD DIM: METASTABLE INDEX
C 4TH DIM: METASTABLE INDEX
C INPUT :(R*8) XCDA(,,,) = GENERALISED CR PARENT X-CP. COEFFICIENT
C 1ST DIM: TEMPERATURE INDEX
C 2ND DIM: STAGE INDEX (LESS 1)
C 3RD DIM: METASTABLE INDEX
C 4TH DIM: METASTABLE INDEX
C INPUT :(R*8) DENS() = ELECTRON DENSITIES FOR MODEL
C INPUT :(R*8) DENSH() = NEUTRAL HYDROGEN DENSITIES FOR MODEL
C
C INPUT :(I*4) ITEM = CURRENT TEMP/DENSITY INDEX
C
C OUTPUT:(R*8) CFREC( , , ) = RECOMBINATION RATE COEFFICIENTS TO ALL
C METASTABLE IPDIMD;STARTING FROM FIRST TO
C GROUND LEVEL,WITH CFREC(1,IPDIMD,IPDIMD)
C SET TO ZERO
C DIMENSIONS = (IPDIMD,IPDIMD,IZDIMD)
C OUTPUT:(R*8) CFION( , , ) = IONISATION RATE COEFFICIENTS TO ALL
C METASTABLE IPDIMD;STARTING FROM GROUND
C TO FIRST LEVEL,WITH
C CFION(NSTAGE,IPDIMD,IPDIMD)
C SET TO ZERO
C DIMENSIONS = (IPDIMD,IPDIMD,IZDIMD)
C OUTPUT:(R*8) CFMET( , , ) = CROSS COUPLING COEFFICIENTS BETWEEN
C METASTABLE IPDIMD WITH LEADING DIAGONAL
C CALCULATED
C DIMENSIONS = (IPDIMD,IPDIMD,IZDIMD)
C
C OUTPUT:(R*8) POPN( , , ) = ARRAY HOLDING POPULATION STATE VALUES
C WITH SECOND DIMENSION SET TO 1
C DIMENSIONS = (IPDIMD,NDONE,IZDIMD+1)
C OUTPUT:(R*8) POPNMO( , , ) =TEMPORARY NAME OF MATRIX HOLDING POPULATI ON
C STATE VALUES AFTER NORMALIZATION,TO BE
C SUBSTITUTED INTO NEXT EQUATION IN
C DOWNWARD LOOP
C DIMENSIONS = (IPDIMD,NDONE,IZDIMD+1)
C OUTPUT:(R*8) POPNPO( , , ) =TEMPORARY NAME OF MATRIX HOLDING POPULATI ON
C STATE VALUES AFTER NORMALIZATION,TO BE
C SUBSTITUTED INTO NEXT EQUATION IN UPWARD
C LOOP
C DIMENSIONS = (IPDIMD,NDONE,IZDIMD+1)
C
C OUTPUT:(R*8) CPOPN( , , ) = ARRAY HOLDING COEFFICIENTS OF POPULATION
C STATE EQUATIONS
C DIMENSIONS = (IPDIMD,IPDIMD,IZDIMD+1)
C OUTPUT:(R*8) CPOPND( , , ) = TEMPORARY NAME OF MATRIX TO BE SUBSTITUTED
C INTO NEXT EQUATION IN UPWARD LOOP
C DIMENSIONS = (IPDIMD,IPDIMD,IZDIMD+1)
C OUTPUT:(R*8) CPOPNZ( , , ) = TEMPORARY NAME OF MATRIX TO BE SUBSTITUTED
C INTO NEXT EQUATION IN DOWNWARD LOOP
C DIMENSIONS = (IPDIMD,IPDIMD,IZDIMD+1)
C
C OUTPUT:(R*8) POPF() = POPULATIONS FOR A SPECIFIED TEMPERATURE D
C 1ST DIM: INDEX OVER STAGES/METASTABLES
C
C OUTPUT:(R*8) XTEMP( , ) =TEMPORARY MATRIX USED DURING SUBROUTINE
C CALCULATIONS
C DIMENSIONS = (IPDIMD,IPDIMD)
C OUTPUT:(R*8) YTEMP( , ) =TEMPORARY MATRIX FOR DURING SUBROUTINE
C CALCULATIONS
C DIMENSIONS = (IPDIMD,IPDIMD)
C OUTPUT:(R*8) YTEM( ) = TEMPORARY ARRAY FOR HOLDING VALUES OF
C DIFFERENCE BETWEEN RECOMBINATION AND
C IONISATION GROUND LEVEL COEFFICIENTS
C DIMENSIONS = (NSTAGE)
C
C OUTPUT:(R*8) RHS( ) = SIPHONED OFF COLUMN OF NORMALIZATION
C MATRIX,USED TO CALCULATE METASTABLE
C IPDIMD OF DOMINANT STAGE THROUGH MATINV
C DIMENSIONS = (2*IPDIMD-1)
C OUTPUT:(R*8) RDUM( ) = DUMMY ARRAY USED IN MATINV AS RHS WHEN
C LSOLVE = FALSE
C OUTPUT:(R*8) SOLVE( , ) = NORMALIZATION MATRIX AT CRITICAL STAGE
C DIMENSIONS = (2*IPDIMD-1,2*IPDIMD-1)
C OUTPUT:(L*4) LSOLVE = .TRUE. => SOLVE SET OF EQUATIONS
C = .FALSE. => INVERT MATRIX ONLY
C
C (I*4) NDONE = PARAMETER = 1 TO ALLOW 3D MATRIX USE
C (I*4) ID = POSITION OF DOMINANT TERM
C (I*4) ISTATE = STAGE INDEX
C (I*4) ITEM = GENERAL INDEX
C (I*4) I = GENERAL INDEX
C (I*4) J = GENERAL INDEX
C (I*4) K = GENERAL INDEX
C (R*8) YMIN = VALUE OF DIFFERENCE BETWEEN
C RECOMBINATION AND IONISATION COEFFICIENTS
C OF GROUND IPDIMD
C
C ROUTINES:
C ROUTINE SOURCE BRIEF DESCRIPTION
C ----------------------------------------------------------
C D5DIAG ADAS SETS UP ON-DIAGONAL ELEMENT OF MATRIX
C D5MFSP ADAS EXECUTES PARTITION MATRIX INVERSION
C DXMADD ADAS MATRIX ADDITION/SUBTRACTION
C DXMMUL ADAS MATRIX MULTIPLICATION
C XXMINV ADAS MATRIX INVERSION
C
C
C AUTHOR: D. BROOKS, H. P. SUMMERS, JET
C K1/1/57
C JET EXT. 4941
C
C DATE: 02/06/94
C
C UPDATE: 14/02/95 HPS - INTRODUCED IAGAIN TO IMPROVE DOMINANT STAGE
C IDENTIFICATION. CHANGED A LOOP LIMIT.
C UNIX-IDL PORT:
C
C VERSION: 1.1 DATE: 08-11-95
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - FIRST RELEASE
C
C VERSION: 1.2 DATE: 01-12-95
C MODIFIED: TIM HAMMOND (TESSELLA SUPPORT SERVICES PLC)
C - COPIED FOLLOWING CHANGES MADE BY DAVID BROOKS
C
C UPDATE: 29/11/95 DHB - CHANGED THE METHOD FOR THE FIRST GUESS AT THE
C DOMINANT STAGE TO AVOID DIVISION BY ZERO
C ERRORS IN D5MFSP. NOW PICK A STAGE THAT HAS AN
C INVERTIBLE SOLUTION AND ADJUST AFTER THE
C POPULATION FRACTIONS HAVE BEEN CALCULATED.
C
C-------------------------------------------------------------------------------
INTEGER IPDIMD, ITEM, ITMAX, IZDIMD
INTEGER NMSUM, NPRT(IZDIMD), NSTAGE
INTEGER NTDIM
LOGICAL LSOLVE
REAL*8 ACDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 CCDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 CFION(IPDIMD,IPDIMD,IZDIMD)
REAL*8 CFMET(IPDIMD,IPDIMD,IZDIMD)
REAL*8 CFREC(IPDIMD,IPDIMD,IZDIMD)
REAL*8 CPOPN(IPDIMD,IPDIMD,IZDIMD+1)
REAL*8 CPOPND(IPDIMD,IPDIMD,IZDIMD+1)
REAL*8 CPOPNZ(IPDIMD,IPDIMD,IZDIMD+1)
REAL*8 DENS(NTDIM), DENSH(NTDIM)
REAL*8 POPF(NMSUM), POPN(IPDIMD,NDONE,IZDIMD+1)
REAL*8 POPNMO(IPDIMD,NDONE,IZDIMD+1)
REAL*8 POPNPO(IPDIMD,NDONE,IZDIMD+1)
REAL*8 QCDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 RDUM(IPDIMD), RHS(2*IPDIMD-1)
REAL*8 SCDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 SOLVE(2*IPDIMD-1,2*IPDIMD-1)
REAL*8 XCDA(NTDIM,IZDIMD,IPDIMD,IPDIMD)
REAL*8 XTEMP(IPDIMD,IPDIMD), YTEM(IZDIMD)
REAL*8 YTEMP(IPDIMD,IPDIMD)