Search Site | Contact Details | FAQ

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)
© Copyright 1995-2018 The ADAS Project
Comments and questions to: adas-at-adas.ac.uk