ADAS Subroutine xxdata_40
subroutine xxdata_40( iunit , dsname ,
& nstore , ndpix , ntdim , nddim ,
& ndptnl , ndptn , ndptnc , ndcnct ,
& ndstack, ndcmt ,
& iz0 , is , is1 , esym ,
& nptnl , nptn , nptnc ,
& iptnla , iptna , iptnca ,
& ncnct , icnctv ,
& ncptn_stack , cptn_stack ,
& lres , lptn , lcmt , lsup ,
& nbsel , isela ,
& npixa , cfile , ctype , cindm ,
& ispbr , isppr , isstgr , ilzr , ihzr ,
& wvmina , wvmaxa ,
& ita , ida ,
& teta , teda ,
& fpec , fpec_max,
& ncmt_stack , cmt_stack
& )
c-----------------------------------------------------------------------
c
c ***************** fortran77 subroutine: xxdata_40 *******************
c
c purpose: To fetch data from an input feature photon emissivity
c file for a given emitting element superstage .
c
c calling programs: adas416/dxdata_40
c
c data: Up to 'nstore' sets (data-blocks) of data may be read from
c the file - each block forming a complete feature photon
c emissivity coefft. for given temp/density grid and wave-.
c length range. Each data-block is analysed independently
c of any other datablock.
c
c the units used in the data file are taken as follows:
c
c temperatures : ev
c densities : cm-3
c pec : phot. cm3 s-1 pixel-1
c
c subroutine:
c
c input : (i*4) iunit = unit to which input file is allocated.
c (i*4) dsname = name of opened data set on iunit
c
c (i*4) nstore = maximum number of input data-blocks that
c can be stored.
c (i*4) npix = maximum number of pixels in a data-blocks
c that can be stored.
c (i*4) ntdim = max number of electron temperatures allowed
c (i*4) nddim = max number of electron densities allowed
c (i*4) ndptnl = maximum level of partitions
c (i*4) ndptn = maximum no. of partitions in one level
c (i*4) ndptnc = maximum no. of components in a partition
c (i*4) ndcnct = maximum number of elements in connection
c (i*4) ndstack = maximum number of partition text lines
c (i*4) ndcmt = maximum number of comment text lines
c vector
c output: (i*4) iz0 = read - emitting ion - nuclear charge
c (i*4) is = read - emitting ion - charge
c (generalised to superstage label)
c (i*4) is1 = read - emitting ion - charge + 1
c (generalised to superstage index= is + 1)
c (c*2) esym = read - emitting ion - element symbol
c
c (i*4) nptnl = number of partition levels in block
c (i*4) nptn() = number of partitions in partition level
c 1st dim: partition level
c (i*4) nptnc(,) = number of components in partition
c 1st dim: partition level
c 2nd dim: member partition in partition level
c (i*4) iptnla() = partition level label (0=resolved root,1=
c unresolved root)
c 1st dim: partition level index
c (i*4) iptna(,) = partition member label (labelling starts at 0)
c 1st dim: partition level index
c 2nd dim: member partition index in partition
c level
c (i*4) iptnca(,,)= component label (labelling starts at 0)
c 1st dim: partition level index
c 2nd dim: member partition index in partition
c level
c 3rd dim: component index of member partition
c (i*4) ncnct = number of elements in connection vector
c (i*4) icnctv() = connection vector of number of partitions
c of each superstage in resolved case
c including the bare nucleus
c 1st dim: connection vector index
c (i*4) ncptn_stack = number of text lines in partition block
c (c*80) cptn_stack()= text lines in partition block
c 1st dim: text line index (1->ncptn_stack)
c
c (l*4) lres = .true. => partial file
c = .false. => not partial file
c (l*4) lptn = .true. => partition block present
c = .false. => partition block not present
c (l*4) lcmt = .true. => comment text block present
c = .false. => comment text block not present
c (l*4) lsup = .true. => ss use of filmem field
c = .false. => old use of filmem field
c
c (i*4) nbsel = number of data-blocks accepted & read in.
c (i*4) isela() = read - data-set data-block entry indices
c dimension: data-block index
c
c (i*4) npixa() = number of pixels for data block
c 1st dim: data-block index
c (c*8) cfile() = specific ion file source string in older
c forms. Field not present in superstage
c version, but reused for added information
c 1st dim: data-block index
c (c*8) ctype() = data type string
c 1st dim: data-block index
c (c*2) cindm() = metastable index string
c 1st dim: data-block index
c
c (i*4) isppr() = parent index for each feature block
c 1st dim: index of block in adf40 file
c (i*4) ispbr() = base index for each feature block
c 1st dim: index of block in adf40 file
c (i*4) isstgr() = s1 for each resolved data block
c 1st dim: index of block in adf40 file
c (i*4) ilzr() = lowest ion charge relating to feature
c 1st dim: index of block in adf40 file
c (i*4) ihzr() = highest ion charge relating to feature
c 1st dim: index of block in adf40 file
c
c (r*8) wvmina() = lowest wavelength of feature block
c dimension: data-block index
c (r*8) wvmaxa() = highest wavelength of feature block
c dimension: data-block index
c
c (i*4) ita() = number of electron temperatures
c dimension: data-block index
c (i*4) ida() = read - number of electron densities
c 1st dim: data-block index
c
c (r*8) teta(,) = electron temperatures (units: ev)
c 1st dim: electron temperature index
c 2nd dim: data-block index
c (r*8) teda(,) = electron densities (units: cm-3)
c 1st dim: electron density index
c 2nd dim: data-block index
c
c (r*8) fpec(,,,) = feature photon emissivity coeffts
c 1st dim: pixel index
c 2nd dim: electron temperature index
c 3rd dim: electron density index
c 4th dim: data-block index
c (r*8) fpec_max()= feature photon emissivity coefft. power
c integral maximum (over wavelength interval)
c as a function of Te at first Ne value
c 1st dim: data-block index
c (i*4) ncmt_stack = number of text lines in comment block
c (c*80) cmt_stack()= text lines in comment block
c 1st dim: text line index (1->ncmt_stack)
c
c routine: (i*4) i4eiz0 = function - (see routines section below)
c (i*4) i4fctn = function - (see routines section below)
c (i*4) i4unit = function - (see routines section below)
c (i*4) iblk = array index: data-block index
c (i*4) itt = array index: electron temperature index
c (i*4) itd = array index: electron density index
c (i*4) ntnum = number of electron temperatures for current
c data-block
c (i*4) ndnum = number of electron densities for current
c data-block
c (i*4) iabt = return code from 'i4fctn'
c (i*4) ipos1 = general use string index variable
c (i*4) ipos2 = general use string index variable
c
c (l*4) lbend = identifies whether the last of the input
c data sub-blocks has been located.
c (.true. => end of sub-blocks reached)
c
c (c*1) cslash = '/' - delimiter for 'xxhkey'
c (c*2) c2 = general use two byte character string
c (c*5) ionnam = emitting ion read from dataset
c (c*6) ckey1 = 'filmem' - input block header key
c (c*4) ckey2 = 'type ' - input block header key
c (c*4) ckey3 = 'indm ' - input block header key
c (c*4) ckey4 = 'isel ' - input block header key
c (c*80) c80 = general use 80 byte character string for
c the input of data-set records.
c
c routines:
c routine source brief description
c ------------------------------------------------------------
c i4eiz0 adas returns z0 for given element symbol
c i4fctn adas convert character string to integer
c i4unit adas fetch unit number for output of messages
c r8fctn adas convert string to real number
c xxmkrp adas make up root partition text lines
c xxcase adas convert a string to upper or lower case
c xxhkey adas obtain key/response strings from text
c xxrptn adas analyse an adf11 file partition block
c xxword adas extract position of number in buffer
c xxslen adas find string less front and tail blanks
c
c author: h. p. summers, university of strathclyde
c ja7.08
c tel. 0141-548-4196
c
c date: 13/06/06
c
c
c version : 1.1
c date : 25-11-2004
c modified : martin o'mullane
c - first version
c
c version : 1.2
c date : 29-11-2004
c modified : martin o'mullane
c - faulty 1001 format statement.
c
c version : 1.3
c date : 15-05-2006
c modified : Hugh Summers
c - complete rewrite for operation with superstages and
c partitions, made similar to xxdata_15.for .
c
c version : 1.4
c date : 06-11-2006
c modified : Allan Whiteford
c - correction of indexing npixa by ipx rather than iblk.
c
c version : 1.5
c date : 15-01-2007
c modified : Hugh Summers
c - corrected metastable count for Ne+0.
c
c-----------------------------------------------------------------------
CHARACTER*8 CFILE(NSTORE)
CHARACTER*2 CINDM(NSTORE)
CHARACTER*80 CMT_STACK(NDCMT), CPTN_STACK(NDSTACK)
CHARACTER*8 CTYPE(NSTORE)
CHARACTER*80 DSNAME
CHARACTER*2 ESYM
INTEGER ICNCTV(NDCNCT), IDA(NSTORE)
INTEGER IHZR(NSTORE), ILZR(NSTORE)
INTEGER IPTNA(NDPTNL,NDPTN)
INTEGER IPTNCA(NDPTNL,NDPTN,NDPTNC)
INTEGER IPTNLA(NDPTNL), IS, IS1
INTEGER ISELA(NSTORE), ISPBR(NSTORE)
INTEGER ISPPR(NSTORE), ISSTGR(NSTORE)
INTEGER ITA(NSTORE), IUNIT, IZ0, NBSEL
INTEGER NCMT_STACK, NCNCT, NCPTN_STACK, NDCMT
INTEGER NDCNCT, NDDIM, NDPIX, NDPTN
INTEGER NDPTNC, NDPTNL, NDSTACK
INTEGER NPIXA(NSTORE), NPTN(NDPTNL)
INTEGER NPTNC(NDPTNL,NDPTN), NPTNL, NSTORE
INTEGER NTDIM
LOGICAL LCMT, LPTN, LRES, LSUP
REAL*8 FPEC(NDPIX,NTDIM,NDDIM,NSTORE)
REAL*8 FPEC_MAX(NSTORE), TEDA(NDDIM,NSTORE)
REAL*8 TETA(NTDIM,NSTORE), WVMAXA(NSTORE)
REAL*8 WVMINA(NSTORE)